cancel-in-progress: true
env:
- res: 0
+ failed: 0
TESTDIR: >-
C:\Бактріан🐫
STR_UTF8: >-
runs-on: ubuntu-latest
steps:
- name: Checkout OCaml
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
persist-credentials: false
- name: Configure, build and install OCaml
set -x
./configure --disable-warn-error --disable-ocamldoc \
--disable-ocamltest --disable-stdlib-manpages \
- --disable-dependency-generation --prefix="$PREFIX" || res=$?
- if ! [ "$res" = 0 ]; then cat config.log; exit "$res"; fi
+ --disable-dependency-generation --prefix="$PREFIX" || failed=$?
+ if ((failed)) ; then set +x
+ echo ; echo "::group::config.log content ($(wc -l config.log) lines)"
+ cat config.log ; echo '::endgroup::' ; exit $failed
+ fi
make -j
make install
cd "$HOME"
sudo apt-get update -y
sudo apt-get install -y gcc-mingw-w64-x86-64
- name: Checkout OCaml
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
submodules: true
persist-credentials: false
run: |
set -x
./configure --prefix="$HOME/cross" --target=x86_64-w64-mingw32 \
- TARGET_LIBDIR="$TESTDIR" || res=$?
- if ! [ "$res" = 0 ]; then cat config.log; exit "$res"; fi
+ TARGET_LIBDIR="$TESTDIR" || failed=$?
+ if ((failed)) ; then set +x
+ echo ; echo "::group::config.log content ($(wc -l config.log) lines)"
+ cat config.log ; echo '::endgroup::' ; exit $failed
+ fi
# The OOM-killer may be triggered if the number of parallel
# jobs isn't limited.
make crossopt -j$(nproc)
sudo apt-get update -y
sudo apt-get install -y gcc-aarch64-linux-gnu qemu-user
- name: Checkout OCaml
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
submodules: true
persist-credentials: false
run: |
set -x
./configure --prefix="$HOME/cross" --target=aarch64-linux-gnu \
- || res=$?
- if ! [ "$res" = 0 ]; then cat config.log; exit "$res"; fi
+ || failed=$?
+ if ((failed)) ; then set +x
+ echo ; echo "::group::config.log content ($(wc -l config.log) lines)"
+ cat config.log ; echo '::endgroup::' ; exit $failed
+ fi
make crossopt -j
make installcross
- name: Show opt.opt configuration
cross-android:
runs-on: ubuntu-latest
needs: non-cross
+ env:
+ # https://developer.android.com/ndk/downloads#lts-downloads
+ NDK: r27d # Latest LTS Version
+ API_LEVEL: 21
steps:
- name: Download Artifact
uses: actions/download-artifact@v4
with:
path: |
/home/runner/android
- key: android-ndk
+ key: android-ndk-${{ env.NDK }}
- name: Download the Android NDK
run: |
set -x
mkdir -p "$HOME/android"
cd "$HOME/android"
- wget --no-verbose https://dl.google.com/android/repository/android-ndk-r27b-linux.zip
- unzip android-ndk-r27b-linux.zip
- rm android-ndk-r27b-linux.zip
+ wget --no-verbose "https://dl.google.com/android/repository/android-ndk-$NDK-linux.zip"
+ unzip android-ndk-$NDK-linux.zip
+ rm android-ndk-$NDK-linux.zip
if: steps.cache.outputs.cache-hit != 'true'
- name: Save the Android NDK to cache
uses: actions/cache/save@v4
with:
path: |
/home/runner/android
- key: android-ndk
+ key: android-ndk-${{ env.NDK }}
if: steps.cache.outputs.cache-hit != 'true'
- name: Checkout OCaml
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
persist-credentials: false
- name: Configure, build and install Linux-to-Android OCaml
env:
- TARGET: x86_64-linux-android21
- TOOLDIR: android-ndk-r27b/toolchains/llvm/prebuilt/linux-x86_64/bin
+ TARGET: x86_64-linux-android${{ env.API_LEVEL }}
+ TOOLDIR: android-ndk-${{ env.NDK }}/toolchains/llvm/prebuilt/linux-x86_64/bin
run: |
DIR="$HOME/android/$TOOLDIR"
set -x
AR="$DIR/llvm-ar" \
PARTIALLD="$DIR/ld -r" \
RANLIB="$DIR/llvm-ranlib" \
- STRIP="$DIR/llvm-strip" || res=$?
- if ! [ "$res" = 0 ]; then cat config.log; exit "$res"; fi
+ STRIP="$DIR/llvm-strip" || failed=$?
+ if ((failed)) ; then set +x
+ echo ; echo "::group::config.log content ($(wc -l config.log) lines)"
+ cat config.log ; echo '::endgroup::' ; exit $failed
+ fi
make crossopt -j
make installcross
- name: Show opt.opt configuration
- name: Run example
uses: reactivecircus/android-emulator-runner@v2
with:
- api-level: 21
+ api-level: ${{ env.API_LEVEL }}
arch: x86_64
disable-animations: true
script: |
steps:
- name: Fetch OCaml
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
submodules: true
# We then upload the compiler tree as a build artifact to enable re-use in
# subsequent jobs.
build:
- runs-on: 'ubuntu-24.04'
+ runs-on: ubuntu-latest
outputs:
manual_changed: ${{ steps.manual.outputs.manual_changed }}
steps:
- name: Checkout
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
persist-credentials: false
- name: Check for manual changes
normal:
name: ${{ matrix.name }}
needs: [build, config]
- runs-on: ubuntu-24.04
+ runs-on: ubuntu-latest
strategy:
matrix:
include:
{name: 'linux-O0', os: 'ubuntu-latest',
config_arg: "CFLAGS='-O0'"},
{name: 'linux-arm64', os: 'ubuntu-24.04-arm'},
- {name: 'macos-x86_64', os: 'macos-13'},
- {name: 'macos-arm64', os: 'macos-15'}];
+ {name: 'macos-x86_64', os: 'macos-15-intel'},
+ {name: 'macos-arm64', os: 'macos-latest'}];
// # If this is a pull request, see if the PR has the
// # 'CI: Full matrix' label. This is done using an API request,
// # rather than from context.payload.pull_request.labels, since we
fail-fast: true
steps:
- name: Checkout
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
persist-credentials: false
- name: macOS Dependencies
sudo DevToolsSecurity --enable
spctl developer-mode enable-terminal
# Select latest supported version
- sudo xcode-select -s /Applications/Xcode_${{ matrix.os == 'macos-13' && '15.2' || '16.3' }}.app/Contents/Developer
+ sudo xcode-select -s /Applications/Xcode.app/Contents/Developer
lldb --version
- name: configure tree
run: |
runs-on: ubuntu-latest
needs: config
container:
- image: debian:12
+ image: debian:13
options: --platform linux/i386 --user root
steps:
- name: OS Dependencies
# context variable.
if: failure()
- - uses: actions/checkout@v4
+ - uses: actions/checkout@v5
with:
fetch-depth: 50
persist-credentials: false
ocamlrunparam: b,s=4096
steps:
- name: Checkout OCaml
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
path: ocaml
persist-credentials: false
run: |
bash -xe ocaml/tools/ci/actions/multicoretests.sh ocaml
- name: Checkout multicoretests
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
repository: ocaml-multicore/multicoretests
- ref: 0.8
+ ref: 0.11
path: multicoretests
persist-credentials: false
- name: Checkout QCheck
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
repository: c-cube/qcheck
- ref: v0.25
+ ref: v0.26
path: multicoretests/qcheck
persist-credentials: false
- name: Checkout dune
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
repository: ocaml/dune
- ref: 3.18.0
+ ref: 3.18.2
path: dune
persist-credentials: false
- name: Build and install dune
manual_changed: ${{ steps.manual.outputs.manual_changed }}
steps:
- name: Checkout
- uses: actions/checkout@v4
+ uses: actions/checkout@v5
with:
persist-credentials: false
- name: Install libunwind
-OCaml 5.4.0
----------------
+OCaml 5.4.1 (17 February 2026)
+------------------------------
+
+### Bug fixes:
+
+- #14010: Fix miscompilation / liveness errors for string operations
+ (Mark Shinwell, Xavier Clerc, review by Xavier Leroy and Gabriel Scherer)
+
+- #14065: Fix function signature mismatch of `__tsan_func_exit` with GCC 15.
+ Check in the configure step if the TSan provided internal builtins are the
+ same as what we expect, introduce `caml_tsan_*` wrappers for the `__tsan_*`
+ functions we use.
+ (Hari Hara Naveen S, report by Hari Hara Naveen S,
+ review by Gabriel Scherer, Antonin Décimo, Olivier Nicole)
+
+- #14417: Fix issue with nested packs on macOS.
+ (Vincent Laviron, report by Kate Deplaix, review by Gabriel Scherer)
+
+- #14213: Fix shadow-stack-related crashes with TSan
+ (Olivier Nicole, report by Nathan Taylor, review by Gabriel Scherer and
+ Stefan Muenzel)
+
+- #14255: Fix TSan bug with C calls that take many arguments
+ (Olivier Nicole and Miod Vallat, report by Nathan Taylor, review by Gabriel
+ Scherer)
+
+- private: robustify intern.c
+ (Xavier Leroy and Nicolás Ojeda Bär, review by Olivier Nicole, Mindy Preston,
+ and Edwin Török)
+
+OCaml 5.4.0 (9 October 2025)
+----------------------------
(Changes that can break existing programs are marked with a "*")
- #13921: Set cloexec correctly on CRT file descriptors created by the Unix
library on Windows. The inheritance on the underlying Win32 handles was
correctly set, but the book-keeping for the CRT was leaking the value of
- non-inherited handles which combined with re-use of HANDLE values within
+ non-inherited handles which combined with reuse of HANDLE values within
processes could appear to make a CRT file descriptor "re-open".
(David Allsopp, review by Nicolás Ojeda Bär)
fails. Similarly for anonymous functor calls (of the form `F(struct ... end))
(Clement Blaudeau, review by Gabriel Scherer)
+- #13747: Document support for native debugging with GDB and LLDB.
+ (Tim McGilchrist, review by Daniel Bünzli, Samuel Hym, Olivier Nicole
+ and Antonin Décimo)
+
### Compiler user-interface and warnings:
- #13817: align spellchecking hints with the possibly misspelled identifier/
(Samuel Vivien, review by Florian Angeletti and Gabriel Scherer)
- #13814, 13898: Add an `unused-type-declaration` warning when using
- a `t as 'a` with no other occurences of `'a`
+ a `t as 'a` with no other occurrences of `'a`
(Samuel Vivien, review by Florian Angeletti, Kate Deplaix)
- #13818: better delimited hints in error message
content of a `Tpackage` node
(Samuel Vivien, review by Florian Angeletti)
-- #13866: Modified occurence check that prevents recursive types for it to see
+- #13866: Modified occurrence check that prevents recursive types for it to see
the checked type as a graph rather than a tree
(Samuel Vivien, report by Didier Remy, review by Florian Angeletti
and Jacques Garrigue)
(Antonin Décimo, review by David Allsopp)
- #10696: Introduce __has_attribute and __has_c_attributes in
- <caml/misc.h> to test the support of specific atributes in C
+ <caml/misc.h> to test the support of specific attributes in C
code. Introduce fallthrough as a wrapper around the fallthrough
attribute.
(Antonin Décimo, review by Nicolás Ojeda Bär, Xavier Leroy, and
ifeq "$(UNIX_OR_WIN32)" "win32"
# Ensure that no command can create Cygwin symbolic links by ensuring that
# symlink(2) will fail if native NTFS symlinks aren't available.
+CYGWIN ?=
+MSYS ?=
export CYGWIN := $(strip \
$(filter-out winsymlinks winsymlinks:%, $(CYGWIN)) winsymlinks:nativestrict)
export MSYS := $(strip \
-5.4.0
+5.4.1
# Starting with OCaml 4.14, although the version string that appears above is
# still correct and this file can thus still be used to figure it out,
let incr_int c dbg = add_const c 1 dbg
let decr_int c dbg = add_const c (-1) dbg
+let offset_addr c1 c2 dbg =
+ match c1, c2 with
+ | c, Cconst_int (0, _) -> c
+ | c, Cconst_natint (0n, _) -> c
+ | Cop(Cadda, [c; Cconst_int(n1, _)], _), _ ->
+ Cop(Cadda, [c; add_const c2 n1 dbg], dbg)
+ | _, _ -> Cop (Cadda, [c1; c2], dbg)
+
let rec add_int c1 c2 dbg =
match (c1, c2) with
| (Cconst_int (n, _), c) | (c, Cconst_int (n, _)) ->
let unaligned_load_16 ptr idx dbg =
if Arch.allow_unaligned_access
- then Cop(mk_load_mut Sixteen_unsigned, [add_int ptr idx dbg], dbg)
+ then Cop(mk_load_mut Sixteen_unsigned, [offset_addr ptr idx dbg], dbg)
else
let cconst_int i = Cconst_int (i, dbg) in
- let v1 = Cop(mk_load_mut Byte_unsigned, [add_int ptr idx dbg], dbg) in
+ let v1 = Cop(mk_load_mut Byte_unsigned, [offset_addr ptr idx dbg], dbg) in
let v2 = Cop(mk_load_mut Byte_unsigned,
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) in
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 1) dbg],
+ dbg) in
let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in
Cop(Cor, [lsl_int b1 (cconst_int 8) dbg; b2], dbg)
if Arch.allow_unaligned_access
then
Cop(Cstore (Sixteen_unsigned, Assignment),
- [add_int ptr idx dbg; newval], dbg)
+ [offset_addr ptr idx dbg; newval], dbg)
else
let cconst_int i = Cconst_int (i, dbg) in
let v1 =
let v2 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in
Csequence(
- Cop(Cstore (Byte_unsigned, Assignment), [add_int ptr idx dbg; b1], dbg),
+ Cop(Cstore (Byte_unsigned, Assignment), [offset_addr ptr idx dbg; b1],
+ dbg),
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], dbg))
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 1) dbg; b2],
+ dbg))
let unaligned_load_32 ptr idx dbg =
if Arch.allow_unaligned_access
- then Cop(mk_load_mut Thirtytwo_unsigned, [add_int ptr idx dbg], dbg)
+ then Cop(mk_load_mut Thirtytwo_unsigned, [offset_addr ptr idx dbg], dbg)
else
let cconst_int i = Cconst_int (i, dbg) in
- let v1 = Cop(mk_load_mut Byte_unsigned, [add_int ptr idx dbg], dbg) in
+ let v1 = Cop(mk_load_mut Byte_unsigned, [offset_addr ptr idx dbg], dbg) in
let v2 = Cop(mk_load_mut Byte_unsigned,
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg)
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 1) dbg],
+ dbg)
in
let v3 = Cop(mk_load_mut Byte_unsigned,
- [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg)
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 2) dbg],
+ dbg)
in
let v4 = Cop(mk_load_mut Byte_unsigned,
- [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg)
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 3) dbg],
+ dbg)
in
let b1, b2, b3, b4 =
if Arch.big_endian
let unaligned_set_32 ptr idx newval dbg =
if Arch.allow_unaligned_access
then
- Cop(Cstore (Thirtytwo_unsigned, Assignment), [add_int ptr idx dbg; newval],
+ Cop(Cstore (Thirtytwo_unsigned, Assignment),
+ [offset_addr ptr idx dbg; newval],
dbg)
else
let cconst_int i = Cconst_int (i, dbg) in
let v1 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int 24], dbg); cconst_int 0xFF], dbg)
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int 24], dbg); cconst_int 0xFF],
+ dbg)
in
let v2 =
- Cop(Cand, [Cop(Clsr, [newval; cconst_int 16], dbg); cconst_int 0xFF], dbg)
+ Cop(Cand, [Cop(Clsr, [newval; cconst_int 16], dbg); cconst_int 0xFF],
+ dbg)
in
let v3 =
Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF], dbg)
Csequence(
Csequence(
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int ptr idx dbg; b1], dbg),
+ [offset_addr ptr idx dbg; b1], dbg),
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 1) dbg;
+ b2],
dbg)),
Csequence(
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 2) dbg;
+ b3],
dbg),
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 3) dbg;
+ b4],
dbg)))
let unaligned_load_64 ptr idx dbg =
if Arch.allow_unaligned_access
- then Cop(mk_load_mut Sixtyfour, [add_int ptr idx dbg], dbg)
+ then Cop(mk_load_mut Sixtyfour, [offset_addr ptr idx dbg], dbg)
else
let cconst_int i = Cconst_int (i, dbg) in
- let v1 = Cop(mk_load_mut Byte_unsigned, [add_int ptr idx dbg], dbg) in
+ let v1 = Cop(mk_load_mut Byte_unsigned, [offset_addr ptr idx dbg], dbg) in
let v2 = Cop(mk_load_mut Byte_unsigned,
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) in
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 1) dbg],
+ dbg) in
let v3 = Cop(mk_load_mut Byte_unsigned,
- [add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg) in
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 2) dbg],
+ dbg) in
let v4 = Cop(mk_load_mut Byte_unsigned,
- [add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg) in
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 3) dbg],
+ dbg) in
let v5 = Cop(mk_load_mut Byte_unsigned,
- [add_int (add_int ptr idx dbg) (cconst_int 4) dbg], dbg) in
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 4) dbg],
+ dbg) in
let v6 = Cop(mk_load_mut Byte_unsigned,
- [add_int (add_int ptr idx dbg) (cconst_int 5) dbg], dbg) in
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 5) dbg],
+ dbg) in
let v7 = Cop(mk_load_mut Byte_unsigned,
- [add_int (add_int ptr idx dbg) (cconst_int 6) dbg], dbg) in
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 6) dbg],
+ dbg) in
let v8 = Cop(mk_load_mut Byte_unsigned,
- [add_int (add_int ptr idx dbg) (cconst_int 7) dbg], dbg) in
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 7) dbg],
+ dbg) in
let b1, b2, b3, b4, b5, b6, b7, b8 =
if Arch.big_endian
then v1, v2, v3, v4, v5, v6, v7, v8
let unaligned_set_64 ptr idx newval dbg =
if Arch.allow_unaligned_access
- then Cop(Cstore (Sixtyfour, Assignment), [add_int ptr idx dbg; newval], dbg)
+ then
+ Cop(Cstore (Sixtyfour, Assignment), [offset_addr ptr idx dbg; newval], dbg)
else
let cconst_int i = Cconst_int (i, dbg) in
let v1 =
Csequence(
Csequence(
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int ptr idx dbg; b1],
+ [offset_addr ptr idx dbg; b1],
dbg),
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 1)
+ dbg; b2],
dbg)),
Csequence(
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 2)
+ dbg; b3],
dbg),
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 3)
+ dbg; b4],
dbg))),
Csequence(
Csequence(
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 4) dbg; b5],
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 4)
+ dbg; b5],
dbg),
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 5) dbg; b6],
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 5)
+ dbg; b6],
dbg)),
Csequence(
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 6) dbg; b7],
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 6)
+ dbg; b7],
dbg),
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int (add_int ptr idx dbg) (cconst_int 7) dbg; b8],
+ [offset_addr (offset_addr ptr idx dbg) (cconst_int 7)
+ dbg; b8],
dbg))))
let max_or_zero a dbg =
let stringref_unsafe arg1 arg2 dbg =
tag_int(Cop(mk_load_mut Byte_unsigned,
- [add_int arg1 (untag_int arg2 dbg) dbg],
+ [offset_addr arg1 (untag_int arg2 dbg) dbg],
dbg)) dbg
let stringref_safe arg1 arg2 dbg =
Csequence(
make_checkbound dbg [string_length str dbg; idx],
Cop(mk_load_mut Byte_unsigned,
- [add_int str idx dbg], dbg))))) dbg
+ [offset_addr str idx dbg], dbg))))) dbg
let string_load size unsafe arg1 arg2 dbg =
box_sized size dbg
let bytesset_unsafe arg1 arg2 arg3 dbg =
return_unit dbg (Cop(Cstore (Byte_unsigned, Assignment),
- [add_int arg1 (untag_int arg2 dbg) dbg;
+ [offset_addr arg1 (untag_int arg2 dbg) dbg;
ignore_high_bit_int (untag_int arg3 dbg)], dbg))
let bytesset_safe arg1 arg2 arg3 dbg =
Csequence(
make_checkbound dbg [string_length str dbg; idx],
Cop(Cstore (Byte_unsigned, Assignment),
- [add_int str idx dbg; newval],
+ [offset_addr str idx dbg; newval],
dbg))))))
let arrayset_unsafe kind arg1 arg2 arg3 dbg =
let call_entry =
Cmm_helpers.return_unit dbg_none
(Cop
- ( Cextcall ("__tsan_func_entry", typ_void, [], false),
+ ( Cextcall ("caml_tsan_func_entry_asm", typ_void, [], false),
[Creturn_addr],
dbg_none ))
in
let call_exit =
Cmm_helpers.return_unit dbg_none
- (Cop (Cextcall ("__tsan_func_exit", typ_void, [], false), [], dbg_none))
+ (Cop (Cextcall ("caml_tsan_func_exit_asm", typ_void, [], false),
+ [], dbg_none))
in
(* [is_tail] is true when the expression is in tail position *)
let rec insert_call_exit is_tail = function
m4_define([OCAML__VERSION_MAJOR], [5])
m4_define([OCAML__VERSION_MINOR], [4])
-m4_define([OCAML__VERSION_PATCHLEVEL], [0])
+m4_define([OCAML__VERSION_PATCHLEVEL], [1])
# Note that the OCAML__VERSION_EXTRA string defined below is always empty
# for officially-released versions of OCaml.
m4_define([OCAML__VERSION_EXTRA], [])
fi
fi
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.71 for OCaml 5.4.0.
+# Generated by GNU Autoconf 2.71 for OCaml 5.4.1.
#
# Report bugs to <caml-list@inria.fr>.
#
# Identity of this package.
PACKAGE_NAME='OCaml'
PACKAGE_TARNAME='ocaml'
-PACKAGE_VERSION='5.4.0'
-PACKAGE_STRING='OCaml 5.4.0'
+PACKAGE_VERSION='5.4.1'
+PACKAGE_STRING='OCaml 5.4.1'
PACKAGE_BUGREPORT='caml-list@inria.fr'
PACKAGE_URL='http://www.ocaml.org'
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures OCaml 5.4.0 to adapt to many kinds of systems.
+\`configure' configures OCaml 5.4.1 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OCaml 5.4.0:";;
+ short | recursive ) echo "Configuration of OCaml 5.4.1:";;
esac
cat <<\_ACEOF
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OCaml configure 5.4.0
+OCaml configure 5.4.1
generated by GNU Autoconf 2.71
Copyright (C) 2021 Free Software Foundation, Inc.
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by OCaml $as_me 5.4.0, which was
+It was created by OCaml $as_me 5.4.1, which was
generated by GNU Autoconf 2.71. Invocation command line was
$ $0$ac_configure_args_raw
-{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 5.4.0" >&5
-printf "%s\n" "$as_me: Configuring OCaml version 5.4.0" >&6;}
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 5.4.1" >&5
+printf "%s\n" "$as_me: Configuring OCaml version 5.4.1" >&6;}
# Configuration variables
-VERSION=5.4.0
+VERSION=5.4.1
OCAML_DEVELOPMENT_VERSION=false
OCAML_VERSION_MINOR=4
-OCAML_VERSION_PATCHLEVEL=0
+OCAML_VERSION_PATCHLEVEL=1
OCAML_VERSION_EXTRA=
printf "%s\n" "#define OCAML_VERSION_MINOR 4" >>confdefs.h
-printf "%s\n" "#define OCAML_VERSION_PATCHLEVEL 0" >>confdefs.h
+printf "%s\n" "#define OCAML_VERSION_PATCHLEVEL 1" >>confdefs.h
printf "%s\n" "#define OCAML_VERSION_ADDITIONAL \"\"" >>confdefs.h
printf "%s\n" "#define OCAML_VERSION_EXTRA \"\"" >>confdefs.h
-printf "%s\n" "#define OCAML_VERSION 50400" >>confdefs.h
+printf "%s\n" "#define OCAML_VERSION 50401" >>confdefs.h
-printf "%s\n" "#define OCAML_VERSION_STRING \"5.4.0\"" >>confdefs.h
+printf "%s\n" "#define OCAML_VERSION_STRING \"5.4.1\"" >>confdefs.h
# Works out how many "o"s are needed in quoted strings
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if the installed OCaml compiler can build the cross compiler" >&5
printf %s "checking if the installed OCaml compiler can build the cross compiler... " >&6; }
already_installed_version="$(ocamlc -vnum)"
- if test x"5.4.0" = x"$already_installed_version"
+ if test x"5.4.1" = x"$already_installed_version"
then :
- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes (5.4.0)" >&5
-printf "%s\n" "yes (5.4.0)" >&6; }
+ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes (5.4.1)" >&5
+printf "%s\n" "yes (5.4.1)" >&6; }
else $as_nop
- { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no (5.4.0 vs $already_installed_version)" >&5
-printf "%s\n" "no (5.4.0 vs $already_installed_version)" >&6; }
+ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no (5.4.1 vs $already_installed_version)" >&5
+printf "%s\n" "no (5.4.1 vs $already_installed_version)" >&6; }
as_fn_error $? "exiting" "$LINENO" 5
fi
cross_compiler=true
conftest$ac_exeext conftest.$ac_ext
LDFLAGS="$SAVED_LDFLAGS"
+# We use tsan builtins which are internal functions and might not be
+# backwards compatible. We explicitly check if the compiler uses the
+# same declarations we expect.
+# Some tsan builtins like __tsan_func_exit() have either of two
+# signatures, void (void) or void (void *) (PR #14082).
+# We first do a single check for all builtins for which we expect
+# only one signature, then we check builtins for which we expect one
+# of multiple signatures and set a preprocessor definition according
+# to which one is found.
+ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for ThreadSanitizer builtins" >&5
+printf %s "checking for ThreadSanitizer builtins... " >&6; }
+if test ${ocaml_cv_tsan_builtins+y}
+then :
+ printf %s "(cached) " >&6
+else $as_nop
+ saved_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS -fsanitize=thread $warn_error_flag"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+void AnnotateHappensBefore(const char *f, int l, void *addr);
+void AnnotateHappensAfter (const char *f, int l, void *addr);
+void __tsan_func_entry (void *);
+void __tsan_write8 (void *location);
+
+int
+main (void)
+{
+
+ AnnotateHappensBefore(__FILE__, __LINE__, (void*)0);
+ AnnotateHappensAfter (__FILE__, __LINE__, (void*)0);
+ __tsan_func_entry ((void*)0);
+ __tsan_write8 ((void*)0);
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"
+then :
+ ocaml_cv_tsan_builtins=yes
+else $as_nop
+ ocaml_cv_tsan_builtins=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam \
+ conftest$ac_exeext conftest.$ac_ext
+ LDFLAGS="$saved_LDFLAGS"
+fi
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ocaml_cv_tsan_builtins" >&5
+printf "%s\n" "$ocaml_cv_tsan_builtins" >&6; }
+
+ if test "$ocaml_cv_tsan_builtins" = no
+then :
+ as_fn_error $? "libtsan doesn't provide the expected builtins" "$LINENO" 5
+fi
+
+ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking how many arguments __tsan_func_exit() takes" >&5
+printf %s "checking how many arguments __tsan_func_exit() takes... " >&6; }
+if test ${ocaml_cv_func_which___tsan_func_exit+y}
+then :
+ printf %s "(cached) " >&6
+else $as_nop
+ saved_LDFLAGS="$LDFLAGS"
+
+ # We need warning flags as using the wrong builtins is often a warning
+ LDFLAGS="$LDFLAGS -fsanitize=thread $warn_error_flag"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+void __tsan_func_exit(void);
+int
+main (void)
+{
+__tsan_func_exit();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"
+then :
+ ocaml_cv_func_which___tsan_func_exit=void_void
+else $as_nop
+ # Else branch if the first program fails to link
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+void __tsan_func_exit(void *);
+int
+main (void)
+{
+__tsan_func_exit((void *)0);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"
+then :
+ ocaml_cv_func_which___tsan_func_exit=void_void_p
+else $as_nop
+ ocaml_cv_func_which___tsan_func_exit=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.beam \
+ conftest$ac_exeext conftest.$ac_ext
+ LDFLAGS="$saved_LDFLAGS"
+fi
+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ocaml_cv_func_which___tsan_func_exit" >&5
+printf "%s\n" "$ocaml_cv_func_which___tsan_func_exit" >&6; }
+
+ # Define a C macro based on the detected __tsan_func_exit signature
+ case $ocaml_cv_func_which___tsan_func_exit in #(
+ void_void_p) :
+
+printf "%s\n" "#define HAVE___TSAN_FUNC_EXIT_VOID_VOID_P 1" >>confdefs.h
+ ;; #(
+ void_void) :
+
+printf "%s\n" "#define HAVE___TSAN_FUNC_EXIT_VOID_VOID 1" >>confdefs.h
+ ;; #(
+ *) :
+ as_fn_error $? "libtsan uses an unexpected signature for __tsan_func_exit" "$LINENO" 5 ;;
+esac
+
case $ocaml_cc_vendor in #(
gcc-[0123456789]-*|gcc-10-*|clang-*) :
;; #(
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by OCaml $as_me 5.4.0, which was
+This file was extended by OCaml $as_me 5.4.1, which was
generated by GNU Autoconf 2.71. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config='$ac_cs_config_escaped'
ac_cs_version="\\
-OCaml config.status 5.4.0
+OCaml config.status 5.4.1
configured by $0, generated by GNU Autoconf 2.71,
with options \\"\$ac_cs_config\\"
Try installing it on your system.])])
LDFLAGS="$SAVED_LDFLAGS"
+# We use tsan builtins which are internal functions and might not be
+# backwards compatible. We explicitly check if the compiler uses the
+# same declarations we expect.
+# Some tsan builtins like __tsan_func_exit() have either of two
+# signatures, void (void) or void (void *) (PR #14082).
+# We first do a single check for all builtins for which we expect
+# only one signature, then we check builtins for which we expect one
+# of multiple signatures and set a preprocessor definition according
+# to which one is found.
+ AC_CACHE_CHECK([for ThreadSanitizer builtins],
+ [ocaml_cv_tsan_builtins],
+ [saved_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS -fsanitize=thread $warn_error_flag"
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([[
+void AnnotateHappensBefore(const char *f, int l, void *addr);
+void AnnotateHappensAfter (const char *f, int l, void *addr);
+void __tsan_func_entry (void *);
+void __tsan_write8 (void *location);
+ ]],[[
+ AnnotateHappensBefore(__FILE__, __LINE__, (void*)0);
+ AnnotateHappensAfter (__FILE__, __LINE__, (void*)0);
+ __tsan_func_entry ((void*)0);
+ __tsan_write8 ((void*)0);
+ ]])],
+ [ocaml_cv_tsan_builtins=yes],
+ [ocaml_cv_tsan_builtins=no])
+ LDFLAGS="$saved_LDFLAGS"])
+
+ AS_IF([test "$ocaml_cv_tsan_builtins" = no],
+ [AC_MSG_ERROR([libtsan doesn't provide the expected builtins])])
+
+ AC_CACHE_CHECK([how many arguments __tsan_func_exit() takes],
+ [ocaml_cv_func_which___tsan_func_exit],
+ [saved_LDFLAGS="$LDFLAGS"
+
+ # We need warning flags as using the wrong builtins is often a warning
+ LDFLAGS="$LDFLAGS -fsanitize=thread $warn_error_flag"
+ AC_LINK_IFELSE([AC_LANG_PROGRAM(
+ [[void __tsan_func_exit(void);]],
+ [[__tsan_func_exit();]])],
+ [ocaml_cv_func_which___tsan_func_exit=void_void],
+ # Else branch if the first program fails to link
+ [AC_LINK_IFELSE([AC_LANG_PROGRAM(
+ [[void __tsan_func_exit(void *);]],
+ [[__tsan_func_exit((void *)0);]])],
+ [ocaml_cv_func_which___tsan_func_exit=void_void_p],
+ [ocaml_cv_func_which___tsan_func_exit=no])])
+ LDFLAGS="$saved_LDFLAGS"])
+
+ # Define a C macro based on the detected __tsan_func_exit signature
+ AS_CASE([$ocaml_cv_func_which___tsan_func_exit],
+ [void_void_p], [AC_DEFINE([HAVE___TSAN_FUNC_EXIT_VOID_VOID_P], [1],
+ [ThreadSanitizer exit function signature: void (*)(void*)])],
+ [void_void], [AC_DEFINE([HAVE___TSAN_FUNC_EXIT_VOID_VOID], [1],
+ [ThreadSanitizer exit function signature: void (*)(void)])],
+ [AC_MSG_ERROR([libtsan uses an unexpected signature for __tsan_func_exit])])
+
AS_CASE([$ocaml_cc_vendor],
[gcc-[[0123456789]]-*|gcc-10-*|clang-*],
[],
\input{ocamldep.tex}
\input{ocamldoc.tex}
\input{debugger.tex}
+\input{native-debugger.tex}
\input{profil.tex}
\input{intf-c.tex}
\input{flambda.tex}
TRANSF = $(OCAMLRUN) $(TOOLS)/transf
FILES = afl-fuzz.tex comp.tex debugger.tex flambda.tex intf-c.tex \
- lexyacc.tex native.tex ocamldep.tex ocamldoc.tex profil.tex \
- runtime-tracing.tex runtime.tex tail-mod-cons.tex \
+ lexyacc.tex native.tex native-debugger.tex ocamldep.tex ocamldoc.tex \
+ profil.tex runtime-tracing.tex runtime.tex tail-mod-cons.tex \
top.tex tsan.tex unified-options.tex warnings-help.tex
etex-files: $(FILES)
--- /dev/null
+\chapter{Native debugging (gdb, lldb)} \label{c:native-debugger}
+%HEVEA\cutname{native-debugger.html}
+
+\section{s:native-debugger-overview}{Overview}
+
+This chapter describes the support for debugging OCaml executables built with the native-code compiler \texttt{ocamlopt}, using standard native debuggers like GDB or LLDB. We will call this \emph{native debugging}, in contrast to bytecode debugging supported via \texttt{ocamldebug} (chapter~\ref{c:debugger}).
+
+Native debugging is supported on Linux, macOS, and FreeBSD platforms. Windows support is not currently available.
+
+\subsection{ss:native-debugger-dwarf}{DWARF}
+
+OCaml uses the \href{http://dwarfstd.org/}{DWARF} debugging format to describe the debugging information it generates. DWARF is a debugging information format used by many compilers and debuggers to support source-level debugging. It is used in the ELF and Mach-O executable formats.
+
+The debugging information includes two key components:
+
+\textbf{Call Frame Information (CFI):} Describes how to unwind the call stack to generate backtraces. OCaml's CFI information spans across language boundaries-from OCaml code into C runtime functions and through Foreign Function Interface (FFI) calls when the foreign language also provides CFI data.
+
+\textbf{Source Line Mapping:} Maps each machine instruction back to its originating source location, enabling debuggers to display OCaml source code and supporting source-level stepping. For example, the instruction at memory address \texttt{0xdeadbeef} might map to \texttt{myprogram.ml:42}.
+
+OCaml defines its own calling convention detailing how arguments are passed to
+functions, how values are returned from functions, and how registers are used. This
+information is architecture specific and is documented in the source code files
+\emph{asmcomp/<ARCH>/proc.ml} for each architecture.
+
+\subsection{ss:native-debugger-name-mangling}{Name Mangling}
+
+When OCaml compiles source code, it transforms language constructs like functions and module names into \emph{mangled names} that appear in the final executable. These mangled names serve several purposes:
+
+\begin{itemize}
+\item They ensure symbol uniqueness in the compiled binary
+\item They encode module structure and namespace information
+\item They appear in debugger output such as backtraces and symbol lists
+\item They can be used to set breakpoints when source file information isn't available
+\end{itemize}
+
+Current mangling scheme for OCaml 5.3 onwards:
+\begin{itemize}
+\item Linux: \texttt{caml<MODULE\_NAME>.<FUNCTION\_NAME>\_<NNN>}
+\item macOS and Windows MSVC: \texttt{caml<MODULE\_NAME>\$<FUNCTION\_NAME>\_<NNN>}
+\end{itemize}
+
+where \texttt{NNN} is a unique generated number.
+
+\textbf{Example:} A function \texttt{fib} in module \texttt{MyMath} might become \texttt{camlMyMath.fib\_271} on Linux or \texttt{camlMyMath\$fib\_271} on macOS.
+
+\textbf{Note:} OCaml versions before 5.1.1 used double underscores: \texttt{caml<MODULE\_NAME>\_\_<FUNCTION\_NAME>\_<NNN>}.
+
+\subsection{ss:native-debugger-frame-pointers}{Frame Pointers}
+
+Frame pointers provide an alternative method for debuggers to walk the
+call stack. OCaml supports frame pointers on AMD64 and ARM64 platforms.
+
+With frame pointers, each function maintains a \emph{frame pointer} that points to
+the base of its stack frame (the memory region allocated for that function’s
+local variables and call information also known as the activation frame or
+activation record). By chaining these pointers together with return addresses,
+debuggers can reconstruct the complete call stack.
+
+Frame pointers are optional (not necessary for debugging),
+and must be explicitly enabled during compiler configuration
+(see Profiling section \ref{s:ocamlprof-compiling-perf} for details).
+
+\section{s:native-debugger-compilation}{Compiling for Debugging}
+
+Before debugging OCaml programs, the native compiler \texttt{ocamlopt} must be installed with CFI support, which it is by default. You can also explicitly control
+this with the \texttt{--enable-cfi} configure flag when building the compiler.
+
+To perform source-level debugging, compile all code with the \texttt{-g} flag, this records DWARF information for exception backtraces, and generates line information for mapping between assembly and source locations in OCaml. Compiling with \texttt{-g} entails no runtime penalty but will generate larger binaries as they include sections for debugging information. Note that OCaml libraries and other dependencies, need to be compiled with DWARF debugging information, failure to do so will lose source-level debugging features for those sections of code.
+
+Debuggers need access to source files referenced in the DWARF information. For dependencies, consider using opam's build directory preservation:
+
+\begin{verbatim}
+# First tell opam to keep the source code
+$ export OPAMKEEPBUILDDIR=1
+
+# Then, reinstall the packages to force redownloading the sources
+$ opam switch reinstall
+
+# Source code for packages will appear inside the opam switch
+# in a build directory. e.g. _opam/.opam-switch/build/ for a
+# local switch or ~/.opam/<switch_name>/.opam-switch/build
+\end{verbatim}
+
+The following sections demonstrate debugging OCaml programs with GDB and LLDB, showing common workflows and expected outputs.
+
+\section{s:native-debugger-gdb}{Using GDB}
+
+Here we walk through debugging a simple OCaml program using GDB on Linux, showing the commands to use and the expected outputs. Note this session uses Ubuntu 24.04 LTS on AMD64 with OCaml 5.4.
+
+Consider the following program:
+
+\begin{caml_example*}{verbatim}
+(* fib.ml *)
+let rec fib n =
+ if n = 0 then 0
+ else if n = 1 then 1
+ else fib (n-1) + fib (n-2)
+
+let main () =
+ let r = fib 20 in
+ Printf.printf "fib(20) = %d" r
+
+let _ = main ()
+\end{caml_example*}
+
+Compile this program with \texttt{ocamlopt} like so:
+
+\begin{verbatim}
+$ ocamlopt -g -o fib.exe fib.ml
+$ ./fib.exe 20
+fib(20) = 6765
+\end{verbatim}
+
+When run this program prints the 20th Fibonacci number. The use of recursion is an excuse to inspect the call stack. Startup a GDB session for this program:
+
+\begin{verbatim}
+$ gdb ./fib.exe
+\end{verbatim}
+
+Breakpoints can be set using either the mangled names produced by the compiler or a combination of file name and line number. For example:
+
+\begin{verbatim}
+(gdb) break camlFib.fib_ # press tab
+(gdb) break camlFib.fib_271 # 271 happens to be the unique number generated
+Breakpoint 1 at 0x3cd50: file fib.ml, line 2.
+
+(gdb) break fib.ml:7 # breakpoint for main function
+Breakpoint 2 at 0x3cdc0: file fib.ml, line 7.
+\end{verbatim}
+
+Now we can run the program and print a backtrace.
+
+\begin{verbatim}
+(gdb) run
+Starting program: fib.exe
+[Thread debugging using libthread_db enabled]
+Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1".
+
+Breakpoint 2, camlFib.main_273 () at fib.ml:7
+7 let main () =
+(gdb) continue
+Continuing.
+
+Breakpoint 1, camlFib.fib_271 () at fib.ml:2
+2 let rec fib n =
+(gdb) backtrace
+#0 camlFib.fib_270 () at fib.ml:2
+#1 0x0000555555590de1 in camlFib.main_273 () at fib.ml:7
+#2 0x0000555555590e86 in camlFib.entry () at fib.ml:11
+#3 0x000055555558eaa7 in caml_program ()
+#4 <signal handler called>
+#5 0x00005555555de126 in caml_startup_common (pooling=<optimised out>, argv=0x7fffffffe3f8)
+ at runtime/startup_nat.c:132
+#6 caml_startup_common (argv=0x7fffffffe3f8, pooling=<optimised out>) at runtime/startup_nat.c:88
+#7 0x00005555555de19f in caml_startup_exn (argv=<optimised out>) at runtime/startup_nat.c:139
+#8 caml_startup (argv=<optimised out>) at runtime/startup_nat.c:144
+#9 caml_main (argv=<optimised out>) at runtime/startup_nat.c:151
+#10 0x000055555558e892 in main (argc=<optimised out>, argv=<optimised out>) at runtime/main.c:37
+\end{verbatim}
+
+There is also basic support for printing OCaml values using the built-in Python scripting in GDB and \href{https://github.com/ocaml/ocaml/blob/trunk/tools/gdb.py}{tools/gdb.py}. Either find that file in your opam switch e.g. \texttt{~/.opam/5.4.0/.opam-switch/sources/ocaml-compiler.5.4.0/tools/gdb.py} or download it from GitHub. Then load it into GDB using `source`.
+
+\begin{verbatim}
+(gdb) source ~/.opam/5.4.0/.opam-switch/sources/ocaml-compiler.5.4.0/tools/gdb.py
+OCaml support module loaded. Values of type 'value' will now
+print as OCaml values, there is a $Array() convenience function,
+and an 'ocaml' command is available for heap exploration
+(see 'help ocaml' for more information).
+
+(gdb) p (value)$rax
+$1 = caml:14
+
+\end{verbatim}
+
+We can also print other kinds of OCaml values. In order to illustrate this, consider the following program:
+
+\begin{caml_example*}{verbatim}
+(* test_blocks.ml *)
+type t = {s : string; i : int}
+
+let main a b =
+ print_endline "Hello, world!";
+ print_endline a;
+ print_endline b.s
+
+let _ = main "foo" {s = "bar"; i = 42}
+\end{caml_example*}
+
+Compile this program with \texttt{ocamlopt} and load it into GDB:
+
+\begin{verbatim}
+$ ocamlopt -g -o test_blocks.exe test_blocks.ml
+$ gdb ./test_blocks.exe
+(gdb) source ~/.opam/5.4.0/.opam-switch/sources/ocaml-compiler.5.4.0/tools/gdb.py
+...
+(gdb) break camlTest_blocks.main_273
+Breakpoint 1 at 0x16db0: file test_blocks.ml, line 4.
+(gdb) run
+...
+Breakpoint 1, camlTest_blocks.main_273 () at test_blocks.ml:4
+4 let main a b =
+(gdb) p (value)$rax # Print out the first argument to main
+$1 = caml(-):'foo'<3>
+(gdb) p (value)$rbx # Then print the second argument
+$2 = caml(-):('bar', 42) = {caml(-):'bar'<3>, caml:42}
+\end{verbatim}
+
+Note the use of AMD64 register names: \texttt{\$rax} and \texttt{\$rbx} to access the first and second arguments to a function. This follows the OCaml calling convention on AMD64 where \texttt{\$rax} to \texttt{\$r13} hold OCaml function arguments and \texttt{\$rax} holds function results. Consult the \texttt{asmcomp/<ARCH>/proc.ml} file for a specific architecture for further information about OCaml calling conventions.
+
+Executables may not include exact information about where to find the source code used to build them for various reasons. In GDB this appears as an absence of source listings and a `No such file or directory` warning message. In this case GDB supports different ways to tell it where to find the sources. Consult GDB's \href{https://sourceware.org/gdb/current/onlinedocs/gdb.html/Source-Path.html}{Source Path} documentation for full details.
+
+Returning to \texttt{fib.exe} from earlier, the source file has been copied to \texttt{/tmp/fib.ml} where GDB will not find it. Here we use the GDB command \texttt{directory} to tell GDB where to find the source files for \texttt{fib.ml} and the OCaml standard library.
+
+\begin{verbatim}
+$ gdb ./fib.exe
+...
+(gdb) break camlFib.main_276
+(gdb) break camlStdlib__Printf.fprintf_431
+(gdb) run
+...
+Breakpoint 1, 0x00005555555921b0 in camlFib.main () at fib.ml:7
+warning: 9 fib.ml: No such file or directory
+# Update directories to search for source files for fib.ml and OCaml
+(gdb) directory /tmp ~/.opam/5.4.0/.opam-switch/sources/ocaml-compiler.5.4.0/
+Source directories searched: /tmp:/home/user/.opam/5.4.0/.opam-switch/sources/ocaml-compiler.5.4.0:$cdir:$cwd
+(gdb) list
+4 else if n = 1 then 1
+5 else fib (n-1) + fib (n-2)
+6
+7 let main () =
+8 let r = fib 20 in
+9 Printf.printf "fib(20) = %d" r
+10
+11 let _ = main ()
+\end{verbatim}
+
+\subsection{ss:native-debugger-gdb-commands}{GDB Commands}
+
+Summary of interesting OCaml specific GDB commands:
+
+\begin{options}
+\item["break "\var{locspec}]
+Set a breakpoint at all of the code locations matching \var{locspec}, e.g., Using the mangled OCaml names or specifying the linenum in the source file as \texttt{filename:linenum}.
+
+\item["backtrace"]
+Print the backtrace of the entire stack. This will include OCaml source references identifying which stack frame maps to a source location, e.g., \texttt{fib.ml:4}.
+
+\item["disassemble "\var{addresses}]
+Display a range of \var{addresses} as machine instructions. Typically used with the mangled OCaml names to display the assembly for a function.
+
+\item["info "\var{frame}]
+This command prints a verbose description of the selected stack frame.
+
+\item["list "\var{linenum}]
+Print lines centered around line number \var{linenum} in the current source file. This will print the source code for OCaml and the OCaml runtime written in C.
+
+\item["directory "\var{dirname}]
+Add directory \var{dirname} to the front of the source path, several directory names can be supplied separated by \texttt{:}. Useful when directories change between compilation and a debug session.
+
+\end{options}
+
+See the \href{https://sourceware.org/gdb/current/onlinedocs/gdb.html/}{Debugging with GDB} documentation for more details. In general the features described above work with OCaml, failing that GDB will fall back to assembly language debugging. GDB is expected to work on all supported Linux architectures.
+
+\section{s:native-debugger-lldb}{Using LLDB}
+
+Here we will walk through debugging the earlier fib example using LLDB on Linux. Startup an LLDB session using the \texttt{fib.exe} from earlier. Note this session uses Ubuntu 24.04 LTS on ARM64 with OCaml 5.4.
+
+\begin{verbatim}
+$ lldb ./fib.exe
+Current executable set to 'fib.exe' (aarch64).
+(lldb)
+\end{verbatim}
+
+Breakpoints can be set using the OCaml mangled names or using a combination of file name and line number. For example:
+
+\begin{verbatim}
+(lldb) breakpoint set -n camlFib.fib # press tab for autocomplete
+(lldb) breakpoint set -n camlFib.fib_271
+Breakpoint 2: where = fib.exe`camlFib.fib_271 + 80, address = 0x0000000000052360
+(lldb) breakpoint set -f fib.ml -l 7 # breakpoint for line 7 in fib.ml
+Breakpoint 2: where = fib.exe`camlFib.main_272, address = 0x0000000000051088
+(lldb)
+\end{verbatim}
+
+Now we can run the program.
+
+\begin{verbatim}
+(lldb) run
+...
+Process 11391 stopped
+* thread #1, name = 'fib.exe', stop reason = breakpoint 2.1
+ frame #0: 0x0000aaaaaaaf1088 fib.exe`camlFib.main_272 at fib.ml:7
+ 4 else if n = 1 then 1
+ 5 else fib (n-1) + fib (n-2)
+ 6
+-> 7 let main () =
+ 8 let r = fib 20 in
+ 9 Printf.printf "fib(20) = %d" r
+ 10
+...
+(lldb) continue
+Process 28032 resuming
+Process 28032 stopped
+* thread #1, name = 'fib.exe', stop reason = breakpoint 2.1
+ frame #0: 0x0000aaaaaaaf2360 fib.exe`camlFib.fib_271 at fib.ml:5
+ 2 let rec fib n =
+ 3 if n = 0 then 0
+ 4 else if n = 1 then 1
+-> 5 else fib (n-1) + fib (n-2)
+ 6
+ 7 let main () =
+ 8 let r = fib 20 in
+
+(lldb) bt # Print a backtrace
+* thread #1, name = 'fib.exe', stop reason = breakpoint 2.1
+ * frame #0: 0x0000aaaaaaaf2360 fib.exe`camlFib.fib_271 at fib.ml:5
+ frame #1: 0x0000aaaaaaaf23d0 fib.exe`camlFib.main_273 at fib.ml:8
+ frame #2: 0x0000aaaaaaaf2490 fib.exe`camlFib.entry at fib.ml:11
+ frame #3: 0x0000aaaaaaaef748 fib.exe`caml_program + 480
+ frame #4: 0x0000aaaaaab4ab90 fib.exe`caml_start_program + 132
+ frame #5: 0x0000aaaaaab4a5f8 fib.exe`caml_startup_common [inlined] caml_startup_common(pooling=-1430712272, argv=0x0000000000000010) at startup_nat.c:127:9
+ frame #6: 0x0000aaaaaab4a528 fib.exe`caml_startup_common(argv=0x0000000000000010, pooling=-1430712272) at startup_nat.c:86:7
+ frame #7: 0x0000aaaaaab4a670 fib.exe`caml_main [inlined] caml_startup_exn(argv=<unavailable>) at startup_nat.c:134:10
+ frame #8: 0x0000aaaaaab4a66c fib.exe`caml_main [inlined] caml_startup(argv=<unavailable>) at startup_nat.c:139:15
+ frame #9: 0x0000aaaaaab4a66c fib.exe`caml_main(argv=<unavailable>) at startup_nat.c:146:3
+ frame #10: 0x0000aaaaaaaef3d0 fib.exe`main(argc=<unavailable>, argv=<unavailable>) at main.c:37:3
+ frame #11: 0x0000fffff7d784c4 libc.so.6`__libc_start_call_main(main=(fib.exe`main at main.c:31:1), argc=1, argv=0x0000fffffffffc98) at libc_start_call_main.h:58:16
+ frame #12: 0x0000fffff7d78598 libc.so.6`__libc_start_main_impl(main=0x0000aaaaaaba0e68, argc=1, argv=0x0000fffffffffc98, init=<unavailable>, fini=<unavailable>, rtld_fini=<unavailable>, stack_end=<unavailable>) at libc-start.c:360:3
+ frame #13: 0x0000aaaaaaaef470 fib.exe`_start + 48
+\end{verbatim}
+
+There is basic support for printing OCaml values using the built-in Python scripting in LLDB and \href{https://github.com/ocaml/ocaml/blob/trunk/tools/lldb.py}{tools/lldb.py}. Either find that file in your opam switch e.g. \texttt{~/.opam/5.4.0/.opam-switch/sources/ocaml-compiler.5.4.0/tools/lldb.py} or download it from github. Then load it into LLDB using \texttt{command}.
+
+\begin{verbatim}
+(lldb) command script import ~/.opam/5.4.0/.opam-switch/sources/ocaml-compiler.5.4.0/tools/lldb.py
+OCaml support module loaded. Values of type 'value' will now
+print as OCaml values, and an 'ocaml' command is available for
+heap exploration (see 'help ocaml' for more information).
+(lldb) p (value)$x0
+(value) 41 caml:20
+(lldb)
+\end{verbatim}
+
+Note: above we are using an ARM64 Linux machine, so our first argument is passed in the first register \texttt{x0}.
+
+We can also print out all kinds of OCaml values. Reusing the \texttt{test_blocks.exe} program, startup a new LLDB session:
+
+\begin{verbatim}
+$ lldb ./test_blocks.exe
+...
+(lldb) command script import ~/.opam/5.4.0/.opam-switch/sources/ocaml-compiler.5.4.0/tools/gdb.py
+OCaml support module loaded. Values of type 'value' will now
+print as OCaml values, and an 'ocaml' command is available for
+heap exploration (see 'help ocaml' for more information).
+(lldb) breakpoint set -n camlTest_blocks.main_274
+Breakpoint 1: where = test_blocks.exe`camlTest_blocks.main_274 + 44, address = 0x000000000001a6fc
+(lldb) run
+...
+Process 15536 stopped
+* thread #1, name = 'test_blocks.exe', stop reason = breakpoint 1.1
+ frame #0: 0x0000aaaaaaaba6fc test_blocks.exe`camlTest_blocks.main_274 at test_blocks.ml:5
+ 2 type t = {s : string; i : int}
+ 3
+ 4 let main a b =
+-> 5 print_endline "Hello, world!";
+ 6 print_endline a;
+ 7 print_endline b.s
+ 8
+...
+(lldb) p (value)$x0
+(value) 187649984957416 caml(-):'Hello, world!'<13>
+(lldb) p (value)$x1
+(value) 187649984957360 caml(-):('bar', 42)
+\end{verbatim}
+
+Here we use the ARM64 registers named \texttt{\$x0} and \texttt{\$x1} to access the first and second arguments to a function. This follows the OCaml calling convention on ARM64 where \texttt{\$x0} to \texttt{\$x15} hold OCaml function arguments. Consult the \texttt{asmcomp/<ARCH>/proc.ml} file for a specific architecture for further information about OCaml calling conventions.
+
+LLDB supports a feature for specifying how to find the sources. In an LLDB session, using \texttt{settings set target.source-map /tmp/build /my/src/path} remaps the build directory to a source directory and supports multiple pairs of \texttt{from to}.
+
+For example, copying the source file \texttt{fib.ml} to \texttt{/tmp/fib.ml} and using an opam switch for OCaml 5.4.
+
+\begin{verbatim}
+$ lldb ./fib.exe
+(lldb) target create "./fib.exe"
+Current executable set to '/home/user/fib.exe' (x86_64).
+(lldb) br s -n camlStdlib__Printf.fprintf_431
+Breakpoint 1: where = fib.exe`camlStdlib__Printf.fprintf_431 + 16, address = 0x000000000007ddb0
+(lldb) br s -f fib.ml -l 9
+Breakpoint 2: where = fib.exe`camlFib.main_276 + 66, address = 0x00000000000482c2
+(lldb) run
+Process 95112 launched: '/home/user/fib.exe' (x86_64)
+Process 95112 stopped
+* thread #1, name = 'fib.exe', stop reason = breakpoint 1.1
+ frame #0: 0x00005555555d1db0 fib.exe`camlStdlib__Printf.fprintf_431 at printf.ml:27:21
+# No source listing displayed for printf.ml file.
+$ settings set target.source-map /home/user/ /tmp /home/user/.opam/5.4.0/.opam-switch/build/ocaml-variants.5.4.0/ /home/user/.opam/5.4.0/.opam-switch/sources/ocaml-variants.5.4.0/
+\end{verbatim}
+
+\subsection{ss:native-debugger-lldb-commands}{LLDB Commands}
+
+Summary of interesting OCaml specific LLDB commands:
+
+\begin{options}
+\item["breakpoint set -n "\var{symbol}]
+Set a breakpoint at code location matching \var{symbol}, e.g, Using the mangled OCaml name.
+
+\item["breakpoint set -f "\var{filename}" -l "\var{linenum}]
+Set a breakpoint at \var{linenum} in \var{filename}, e.g., \texttt{fib.ml:7}
+
+\item["breakpoint set -a "\var{address}]
+Set a breakpoint on a memory \var{address}.
+
+\item["backtrace"]
+Print the backtrace of the entire stack. This will include OCaml source references identifying which stack frame maps to a source location.
+
+\item["disassemble"]
+Disassemble specified instructions in the current target. Useful options include \texttt{-n} plus mangled OCaml name to disassemble a specific function and \texttt{-a} plus an address to disassemble function containing this address.
+
+\item["frame info"]
+List information about the current stack frame in the current thread.
+
+\item["source"]
+Commands for examining source code described by debug information for the current target process.
+
+\item["settings set target.source-map"\var{from} \var{to}]
+Remaps \var{from} source paths \var{to} a new source path which is used when locating source code to display alongside a debugged program. Multiple pairs of \var{from} \var{to} mappings are supported.
+
+\end{options}
+
+In general the features described above work with OCaml, failing that LLDB will fall back to assembly language debugging. LLDB is expected to work on all supported Linux architectures.
\item Hardware Last Branch Record (LBR).
\end{itemize}
-Frame pointer based call graphs use a convention where a register called the frame pointer holds the address for the beginning of the stack frame, and the previous values for the frame pointer are stored at a known offset from the current frame pointer. Using this information the call graph for the current function can be calculated purely based on the current stack, a process called unwinding. On x86_64 the register used for storing the frame pointer is \$rbp, while ARM64 uses the register x29. OCaml 5 introduced non-contiguous stacks as part of the implementation of effects, see \href{https://dl.acm.org/doi/10.1145/3453483.3454039}{Retrofitting effect handlers onto OCaml} (Section 5.5). Due to this implementation detail, frame pointers work better with the copying nature of perf.
+Frame pointer based call graphs use a convention where a register called the frame pointer holds the address for the beginning of the stack frame, and the previous values for the frame pointer are stored at a known offset from the current frame pointer. Using this information the call graph for the current function can be calculated purely based on the current stack, a process called unwinding. On AMD64 the register used for storing the frame pointer is \$rbp, while ARM64 uses the register \$x29. OCaml 5 introduced non-contiguous stacks as part of the implementation of effects, see \href{https://dl.acm.org/doi/10.1145/3453483.3454039}{Retrofitting effect handlers onto OCaml} (Section 5.5). Due to this implementation detail, frame pointers work better with the copying nature of perf.
DWARF based call graphs use the DWARF CFI information to perform unwinding. However this interacts poorly with the copying nature of perf, often leading to truncated call graphs where not enough of the stack has been copied by \texttt{perf}. It also produces larger trace files that are more costly to capture and process. Finally it requires including CFI debugging information in your program resulting in slightly larger binaries.
opam switch create <YOUR-SWITCH-NAME-HERE> ocaml-option-fp
\end{verbatim}
-Frame pointer support for OCaml is available on x86_64 architecture for Linux starting with OCaml 4.12 and on macOS from OCaml 5.3. ARM64 architecture is supported on Linux and macOS from OCaml 5.4, while other Tier-1 architectures (POWER, RISC-V, and s390x) are currently unsupported.
+Frame pointer support for OCaml is available on AMD64 architecture for Linux starting with OCaml 4.12 and on macOS from OCaml 5.3. ARM64 architecture is supported on Linux and macOS from OCaml 5.4, while other Tier-1 architectures (POWER, RISC-V, and s390x) are currently unsupported.
\subsection{s:ocamlprof-profiling-perf}{Profiling an Execution}
The \texttt{perf record} command works by copying a segment of the call stack at each sample and recording this data into a \texttt{perf.data} file. These samples can then be processed after recording using \texttt{perf report} to reconstruct the profiled program’s call stack at every sample.
-\texttt{perf} uses the symbols present in an OCaml executable, so it helps to understand OCaml's name mangling scheme to map names to OCaml source locations. OCaml 5.4 onwards uses a name mangling scheme of \texttt{caml<MODULE_NAME>\$<FUNCTION_NAME>_<NNN>}, where \texttt{NNN} is a randomly generated number. In OCaml 5.3 the separator is a dot \texttt{caml<MODULE_NAME>.<FUNCTION_NAME>_<NNN>}, and before OCaml 5.1 the separator is double underscores. All formats are supported by \texttt{perf}.
+\texttt{perf} uses the symbols present in an OCaml executable, so it helps to understand OCaml's name mangling scheme to map names to OCaml source locations.
+
+OCaml 5.3 onwards uses a mangling scheme of "caml<MODULE_NAME>.<FUNCTION_NAME>_<NNN>" on Linux, where \texttt{NNN} is a randomly generated number. For macOS and the Windows MSVC port (restored in OCaml 5.3), the scheme uses \texttt{\$} as the separator. Before OCaml 5.1.1 the scheme used two underscores as the separator, e.g., "caml<MODULE_NAME>__<FUNCTION_NAME>_<NNN>". All formats are supported by Linux \texttt{perf}.
Consider the following program:
let _ = main ()
\end{caml_example*}
-This program produces the names \texttt{camlFib\$main_274} for the \texttt{main} function and \texttt{camlFib\$fib_271} for the \texttt{fib} function in the \texttt{Compute} module.
+This program produces the names \texttt{camlFib.main_274} for the \texttt{main} function and \texttt{camlFib.fib_271} for the \texttt{fib} function in the \texttt{Compute} module.
-\subsection{s:ocamlprof-printing}{Displaying profiling information}
+\subsection{s:ocamlprof-printing-perf}{Displaying profiling information}
The \texttt{perf report} command summarises data in the \texttt{perf.data} file.
The basic \texttt{perf report} command is:
\begin{verbatim}
Samples: 809 of event 'cycles', Event count (approx.): 24701952617
Overhead Command Shared Object Symbol
-- 100.00% tak-fp.exe tak-fp.exe [.] Tak\$tak_402
- Tak\$tak_402
- Tak\$tak_402
- + Tak\$tak_402
+- 100.00% tak-fp.exe tak-fp.exe [.] Tak.tak_402
+ Tak.tak_402
+ Tak.tak_402
+ + Tak.tak_402
0.00% tak-fp.exe [kernel.kallsyms] [k] 0xffffb9a5ff79d854
0.00% perf-exec [kernel.kallsyms] [k] 0xffffb9a5ff719c34
\end{verbatim}
Samples: 7K of event 'cycles:P', Event count (approx.): 141874642467
Overhead Command Shared Object Symbol
- 35.90% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig._pow_747
- - 35.29% Sudoku_norvig$_pow_747
- + 17.70% Sudoku_norvig$eliminate_value_760
- + 15.74% Sudoku_norvig$_pow_747
- + 1.03% Sudoku_norvig$fun_1435
- 0.61% Sudoku_norvig$eliminate_value_760
-- 12.99% sudoku_norvig.e sudoku_norvig.exe [.] BatList$findnext_1543
- - 12.00% BatList$findnext_1543
- - 11.71% BatList$find_all_1539
- + 8.07% Sudoku_norvig$fun_1421
- + 2.73% Sudoku_norvig$eliminate_948
- + 0.90% Sudoku_norvig$assign_949
-- 10.63% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig$eliminate_value_760
- + 8.29% Sudoku_norvig$eliminate_value_760
- + 1.93% Sudoku_norvig$_pow_747
+ - 35.29% Sudoku_norvig._pow_747
+ + 17.70% Sudoku_norvig.eliminate_value_760
+ + 15.74% Sudoku_norvig._pow_747
+ + 1.03% Sudoku_norvig.fun_1435
+ 0.61% Sudoku_norvig.eliminate_value_760
+- 12.99% sudoku_norvig.e sudoku_norvig.exe [.] BatList.findnext_1543
+ - 12.00% BatList.findnext_1543
+ - 11.71% BatList.find_all_1539
+ + 8.07% Sudoku_norvig.fun_1421
+ + 2.73% Sudoku_norvig.eliminate_948
+ + 0.90% Sudoku_norvig.assign_949
+- 10.63% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig.eliminate_value_760
+ + 8.29% Sudoku_norvig.eliminate_value_760
+ + 1.93% Sudoku_norvig._pow_747
+ 9.50% sudoku_norvig.e [kernel.kallsyms] [k] asm_exc_nmi
-+ 7.24% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig$fun_1435
++ 7.24% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig.fun_1435
+ 5.06% sudoku_norvig.e sudoku_norvig.exe [.] caml_modify
-+ 3.10% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig$fun_1360
-+ 2.11% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig$eliminate_948
-+ 2.00% sudoku_norvig.e sudoku_norvig.exe [.] Stdlib.List$iter_366
-+ 1.54% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig$fun_1421
++ 3.10% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig.fun_1360
++ 2.11% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig.eliminate_948
++ 2.00% sudoku_norvig.e sudoku_norvig.exe [.] Stdlib.List.iter_366
++ 1.54% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig.fun_1421
+ 1.47% sudoku_norvig.e sudoku_norvig.exe [.] caml_apply2
-+ 1.42% sudoku_norvig.e sudoku_norvig.exe [.] BatList$find_all_1539
-+ 1.20% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig$fun_1366
-+ 1.09% sudoku_norvig.e sudoku_norvig.exe [.] Stdlib.List$fold_left_380
++ 1.42% sudoku_norvig.e sudoku_norvig.exe [.] BatList.find_all_1539
++ 1.20% sudoku_norvig.e sudoku_norvig.exe [.] Sudoku_norvig.fun_1366
++ 1.09% sudoku_norvig.e sudoku_norvig.exe [.] Stdlib.List.fold_left_380
\end{verbatim}
-Note this implementation clearly has some optimsation possible in `_pow_747` a recursive Power of 2 function, and parts of the OCaml runtime `caml_modify` are present.
+Note this implementation clearly has some optimsation possible in "_pow_747" a recursive Power of 2 function, and parts of the OCaml runtime "caml_modify" are present.
Profiling data can also be visualised as Flame Graphs, which highlight the most frequent code paths in stack traces. The original scripts scripts \texttt{stackcollapse-perf.pl} and \texttt{flamegraph.pl} can be found at Brendan Gregg's \href{https://www.brendangregg.com/flamegraphs.html}{Flame Graphs} web page and work as follows:
The basic \texttt{xctrace} command for time profiling is:
\begin{verbatim}
-$ xcrun xctrace record --output . --template "Time Profiler" \
+xcrun xctrace record --output . --template "Time Profiler" \
--target-stdout - --launch -- PROGRAM
\end{verbatim}
-The \texttt{--template "Time Profiler"} selects pre-defined template for time profiling which will create a trace file with extension `.trace` that can be opened with Instruments. Use the \texttt{--output} to select a name for the trace file, by default xctrace will create a new file each run rather than overwriting the existing file.
+The \texttt{--template "Time Profiler"} selects pre-defined template for time profiling which will create a trace file with extension ".trace" that can be opened with Instruments. Use the \texttt{--output} to select a name for the trace file, by default xctrace will create a new file each run rather than overwriting the existing file.
The resulting file can be opened with Instruments to view the profile, and it maybe be possible to generate Flame Graphs using \href{https://github.com/jonhoo/inferno}{inferno} or the scripts from \href{https://github.com/brendangregg/FlameGraph}{https://github.com/brendangregg/FlameGraph}.
\lparagraph{p:ocamlprof-instruments}{Note}
-Sometimes Instruments requires adding entitlements to an OCaml binary before it is able to profile it. This typically shows as a failure to launch the process or as a permission error. To work around this issue run the following command, replacing 'PROGRAM' with the program to trace.
+Sometimes Instruments requires adding entitlements to an OCaml binary before it is able to profile it. This typically shows as a failure to launch the process or as a permission error. To work around this issue run the following command, replacing "PROGRAM" with the program to trace.
\begin{verbatim}
$ codesign -s - -v -f --entitlements =(echo -n
</plist>') PROGRAM
\end{verbatim}
-For more details on entitlements and codesigning consult Apple's documentation.
+For more details on entitlements and codesign consult Apple's documentation.
\section{s:ocamlprof-glossary}{Glossary}
Linkage_name.create (make_symbol ~unitname:current_unit.ui_symbol None)
let reset ?packname name =
+ let packname =
+ Option.map
+ (Misc.replace_substring ~before:"."
+ ~after:(String.make 1 symbol_separator))
+ packname
+ in
Hashtbl.clear global_infos_table;
Set_of_closures_id.Tbl.clear imported_sets_of_closures_table;
let symbol = symbolname_for_pack packname name in
let current_unit_name () =
current_unit.ui_name
-let symbol_in_current_unit name =
- let prefix = "caml" ^ current_unit.ui_symbol in
- name = prefix ||
- (let lp = String.length prefix in
- String.length name >= 2 + lp
- && String.sub name 0 lp = prefix
- && name.[lp] = '_'
- && name.[lp + 1] = '_')
-
let read_unit_info filename =
let ic = open_in_bin filename in
try
ultimately end up in the same pack, including through nested packs. *)
let is_import_from_same_pack ~imported ~current =
String.equal imported current
- || String.starts_with ~prefix:(imported ^ ".") current
+ || String.starts_with ~prefix:(concat_symbol imported "") current
let get_global_info global_ident = (
let modname = Ident.name global_ident in
corresponds to symbol [id] in the compilation unit [u]
(or the current unit). *)
-val symbol_in_current_unit: string -> bool
- (* Return true if the given asm symbol belongs to the
- current compilation unit, false otherwise. *)
-
val is_predefined_exception: Symbol.t -> bool
(* flambda-only *)
opam-version: "2.0"
-version: "5.4.0"
+version: "5.4.1"
license: "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception"
-synopsis: "Official release of OCaml 5.4.0"
+synopsis: "Official OCaml 5.4.1 release"
maintainer: "caml-list@inria.fr"
authors: [
"Xavier Leroy"
homepage: "https://github.com/ocaml/ocaml/"
bug-reports: "https://github.com/ocaml/ocaml/issues"
depends: [
- # This is OCaml 5.4.0
- "ocaml" {= "5.4.0" & post}
+ # This is OCaml 5.4.1
+ "ocaml" {= "5.4.1" & post}
# General base- packages
"base-unix" {post}
/* When ThreadSanitizer instrumentation is enabled, the code must call
- the C functions __tsan_func_entry and __tsan_func_exit to signal
- function entries and exits. They follow the x86_64 calling
- convention of the platform. For efficiency reasons, we don't always
- save all caller-saved registers before calling them, but only the
- registers in use. */
-
-/* Calls __tsan_func_entry on the current return address. [offset] is the
- distance from the current stack pointer to the saved return address, in
+ the C functions caml_tsan_func_entry_asm and caml_tsan_func_exit_asm to
+ signal function entries and exits. They follow the x86_64 calling convention
+ of the platform. For efficiency reasons, we don't always save all
+ caller-saved registers before calling them, but only the registers in use.
+ */
+
+/* Calls caml_tsan_func_entry_asm on the current return address. [offset] is
+ the distance from the current stack pointer to the saved return address, in
bytes. May clobber all caller-saved registers. */
#if defined(WITH_THREAD_SANITIZER)
#define TSAN_ENTER_FUNCTION(offset) \
/* arg 1: pc of raise */ \
movq STACK_RETADDR_OFFSET(%rsp, offset), C_ARG_1; \
SWITCH_OCAML_TO_C; \
- C_call (GCALL(__tsan_func_entry)); \
+ C_call (GCALL(caml_tsan_func_entry_asm)); \
SWITCH_C_TO_OCAML;
-/* Calls __tsan_func_exit. May clobber all caller-saved registers. */
+/* Calls caml_tsan_func_exit_asm. May clobber all caller-saved registers. */
#define TSAN_EXIT_FUNCTION \
SWITCH_OCAML_TO_C; \
- movq $0, C_ARG_1; \
- C_call (GCALL(__tsan_func_exit)); \
+ C_call (GCALL(caml_tsan_func_exit_asm)); \
SWITCH_C_TO_OCAML;
#else
#define TSAN_ENTER_FUNCTION(offset)
#define TSAN_RESTORE_CALLER_REGS
#endif
+#ifdef WITH_THREAD_SANITIZER
+/* Push return value registers %rax and %xmm0 onto the stack. */
+#define TSAN_PUSH_RETURN_REGS \
+ pushq %rax; CFI_ADJUST(8); \
+ subq $16, %rsp; CFI_ADJUST(16); \
+ movupd %xmm0, (%rsp)
+#else
+#define TSAN_PUSH_RETURN_REGS
+#endif
+
+#ifdef WITH_THREAD_SANITIZER
+/* Pop return value registers %rax and %xmm0 from the stack. */
+#define TSAN_POP_RETURN_REGS \
+ movupd (%rsp), %xmm0; \
+ addq $16, %rsp; CFI_ADJUST(-16); \
+ popq %rax; CFI_ADJUST(-8)
+#else
+#define TSAN_POP_RETURN_REGS
+#endif
+
FUNCTION(caml_call_realloc_stack)
CFI_STARTPROC
CFI_SIGNAL_FRAME
movq Caml_state(young_ptr), %r15
/* Load ocaml stack and restore global variables */
SWITCH_C_TO_OCAML
-#ifdef WITH_THREAD_SANITIZER
- /* Save non-callee-saved registers %rax and %xmm0 before C call */
- pushq %rax; CFI_ADJUST(8);
- subq $16, %rsp; CFI_ADJUST(16);
- movupd %xmm0, (%rsp)
+ TSAN_PUSH_RETURN_REGS /* Save return value before C call */
TSAN_EXIT_FUNCTION
- movupd (%rsp), %xmm0
- addq $16, %rsp; CFI_ADJUST(-16);
- popq %rax; CFI_ADJUST(-8);
-#endif
+ TSAN_POP_RETURN_REGS
LEAVE_FUNCTION
/* Return to OCaml caller */
RET_FROM_C_CALL
CFI_STARTPROC
CFI_SIGNAL_FRAME
ENTER_FUNCTION
+ TSAN_SAVE_CALLER_REGS
+ TSAN_ENTER_FUNCTION(0)
+ TSAN_RESTORE_CALLER_REGS
/* Arguments:
C arguments : %rdi, %rsi, %rdx, %rcx, %r8, and %r9
C function : %rax
movq Caml_state(young_ptr), %r15
/* Load ocaml stack and restore global variables */
SWITCH_C_TO_OCAML
+ TSAN_PUSH_RETURN_REGS /* Save return value before C call */
+ TSAN_EXIT_FUNCTION
+ TSAN_POP_RETURN_REGS
/* Return to OCaml caller */
LEAVE_FUNCTION
RET_FROM_C_CALL
pushq %rbp; CFI_ADJUST(8)
movq %rsp, %rbp
CFI_DEF_CFA_REGISTER(DW_REG_rbp)
+#ifdef WITH_THREAD_SANITIZER
+ /* The pushed arguments will be considered to be a stack frame, TSan must
+ know about it. */
+ TSAN_SAVE_CALLER_REGS /* Save the arguments */
+ movq 8(%rsp), C_ARG_1
+ /* Note that we are already on the C stack. For this reason, we do not use
+ the usual TSAN_* macros which assume we start on the OCaml stack. */
+ C_call (GCALL(caml_tsan_func_entry_asm));
+ /* Restore the arguments */
+ TSAN_RESTORE_CALLER_REGS
+#endif
/* Copy arguments from OCaml to C stack */
LBL(105):
subq $8, %r12
#endif
/* Call the function (address in %rax) */
C_call (*%rax)
+#ifdef WITH_THREAD_SANITIZER
+ /* We can't use the TSAN_EXIT_FUNCTION macro as it assumes an OCaml stack,
+ and we are on a C stack. */
+ TSAN_PUSH_RETURN_REGS /* Save return value */
+ C_call (GCALL(caml_tsan_func_exit_asm))
+ TSAN_POP_RETURN_REGS
+#endif
/* Pop arguments back off the stack */
movq %rbp, %rsp
CFI_DEF_CFA_REGISTER(DW_REG_rsp)
pushq C_ARG_1; CFI_ADJUST(8)
/* Read return address */
movq (8 + CALLEE_SAVE_REGS_SIZE)(%rsp), C_ARG_1
- C_call (GCALL(__tsan_func_entry))
+ C_call (GCALL(caml_tsan_func_entry_asm))
popq C_ARG_1; CFI_ADJUST(-8)
#endif
/* Load Caml_state into r14 (was passed as an argument from C) */
#if defined(WITH_THREAD_SANITIZER)
/* We can't use the TSAN_EXIT_FUNCTION macro as it assumes an OCaml stack,
and we are on a C stack. */
- /* Save %rax before C call */
- pushq %rax; CFI_ADJUST(8)
- movq $0, C_ARG_1
- C_call (GCALL(__tsan_func_exit))
- popq %rax; CFI_ADJUST(-8)
+ /* Save return value before C call */
+ TSAN_PUSH_RETURN_REGS
+ C_call (GCALL(caml_tsan_func_exit_asm))
+ TSAN_POP_RETURN_REGS
#endif
/* Restore callee-save registers. */
POP_CALLEE_SAVE_REGS
pushq C_ARG_2; CFI_ADJUST(8)
pushq C_ARG_3; CFI_ADJUST(8)
movq 24(%rsp), C_ARG_1 /* Read return address */
- C_call (GCALL(__tsan_func_entry))
+ C_call (GCALL(caml_tsan_func_entry_asm))
popq C_ARG_3; CFI_ADJUST(-8)
popq C_ARG_2; CFI_ADJUST(-8)
popq C_ARG_1; CFI_ADJUST(-8)
pushq C_ARG_2; CFI_ADJUST(8)
pushq C_ARG_3; CFI_ADJUST(8)
movq 24(%rsp), C_ARG_1 /* Read return address */
- C_call (GCALL(__tsan_func_entry))
+ C_call (GCALL(caml_tsan_func_entry_asm))
popq C_ARG_3; CFI_ADJUST(-8)
popq C_ARG_2; CFI_ADJUST(-8)
popq C_ARG_1; CFI_ADJUST(-8)
pushq C_ARG_2; CFI_ADJUST(8)
pushq C_ARG_3; CFI_ADJUST(8)
movq 24(%rsp), C_ARG_1 /* Read return address */
- C_call (GCALL(__tsan_func_entry))
+ C_call (GCALL(caml_tsan_func_entry_asm))
popq C_ARG_3; CFI_ADJUST(-8)
popq C_ARG_2; CFI_ADJUST(-8)
popq C_ARG_1; CFI_ADJUST(-8)
SWITCH_C_TO_OCAML
.endm
-/* Invoke __tsan_func_entry(return address in the caller) */
+/* Invoke caml_tsan_func_entry_asm (return address in the caller) */
.macro TSAN_ENTER_FUNCTION
mov x0, x30 /* arg1: return address in caller */
- TSAN_C_CALL G(__tsan_func_entry)
+ TSAN_C_CALL G(caml_tsan_func_entry_asm)
.endm
-/* Invoke __tsan_func_exit(0) */
+/* Invoke caml_tsan_func_exit_asm */
.macro TSAN_EXIT_FUNCTION
- mov x0, xzr
- TSAN_C_CALL G(__tsan_func_exit)
+ TSAN_C_CALL G(caml_tsan_func_exit_asm)
.endm
/* This is similar to SAVE_ALL_REGS, but only saving the caller-saved
ldr TRAP_PTR, Caml_state(exn_handler)
.endm
+/* Save return value registers. To cover all possible function returns, save
+ both x0 and d0:d1. */
+.macro TSAN_PUSH_RETURN_REGS
+ stp x0, x1, [sp, -16]!
+ CFI_ADJUST(16)
+ stp d0, d1, [sp, -16]!
+ CFI_ADJUST(16)
+.endm
+
+.macro TSAN_POP_RETURN_REGS
+ ldp d0, d1, [sp], 16
+ CFI_ADJUST(-16)
+ ldp x0, x1, [sp], 16
+ CFI_ADJUST(-16)
+.endm
+
#else /* } { */
.macro TSAN_ENTER_FUNCTION
.macro TSAN_RESTORE_CALLER_REGS
.endm
+.macro TSAN_PUSH_RETURN_REGS
+.endm
+
+.macro TSAN_POP_RETURN_REGS
+.endm
+
#endif /* } WITH_THREAD_SANITIZER */
/* Allocation functions and GC interface.
ldr TRAP_PTR, Caml_state(exn_handler)
/* Load ocaml stack */
SWITCH_C_TO_OCAML
-#if defined(WITH_THREAD_SANITIZER)
- /* Save return value registers. Since the called function could be
- anything, it may have returned its result (if any) either in x0
- or d0:d1. */
- stp x0, x1, [sp, -16]!
- CFI_ADJUST(16)
- stp d0, d1, [sp, -16]!
- CFI_ADJUST(16)
+ TSAN_PUSH_RETURN_REGS
TSAN_EXIT_FUNCTION
- /* Restore return value registers */
- ldp d0, d1, [sp], 16
- CFI_ADJUST(-16)
- ldp x0, x1, [sp], 16
- CFI_ADJUST(-16)
-#endif
+ TSAN_POP_RETURN_REGS
/* Return */
LEAVE_FUNCTION
RET_FROM_C_CALL
C stack args : begin=STACK_ARG_BEGIN
end=STACK_ARG_END */
ENTER_FUNCTION
+ TSAN_SAVE_CALLER_REGS
+ TSAN_ENTER_FUNCTION
+ TSAN_RESTORE_CALLER_REGS
/* Switch from OCaml to C */
SWITCH_OCAML_TO_C
/* Make the exception handler alloc ptr available to the C code */
ldr TRAP_PTR, Caml_state(exn_handler)
/* Switch from C to OCaml */
SWITCH_C_TO_OCAML
+ TSAN_PUSH_RETURN_REGS /* Save returned value. */
+ TSAN_EXIT_FUNCTION
+ TSAN_POP_RETURN_REGS
/* Return */
LEAVE_FUNCTION
RET_FROM_C_CALL
CFI_STARTPROC
ENTER_FUNCTION
CFI_DEF_CFA_REGISTER(DW_REG_x29)
+#if defined(WITH_THREAD_SANITIZER)
+ TSAN_SAVE_CALLER_REGS
+ /* TSAN_ENTER_FUNCTION, but without switching stacks */
+ mov x0, x30 /* arg1: return address in caller */
+ TSAN_SETUP_C_CALL
+ bl G(caml_tsan_func_entry_asm)
+ TSAN_CLEANUP_AFTER_C_CALL
+ TSAN_RESTORE_CALLER_REGS
+#endif
/* Copy arguments from OCaml to C stack
NB: STACK_ARG_{BEGIN,END} are 16-byte aligned */
1: sub STACK_ARG_END, STACK_ARG_END, 16
b 1b
2: /* Call the function */
blr ADDITIONAL_ARG
+#if defined(WITH_THREAD_SANITIZER)
+ TSAN_PUSH_RETURN_REGS /* Save returned value. */
+ /* TSAN_EXIT_FUNCTION, but without switching stacks */
+ TSAN_SETUP_C_CALL
+ bl G(caml_tsan_func_exit_asm)
+ TSAN_CLEANUP_AFTER_C_CALL
+ TSAN_POP_RETURN_REGS
+#endif
/* Restore stack */
mov sp, x29
CFI_DEF_CFA_REGISTER(DW_REG_sp)
OCaml stack, and we are still on a C stack at this point. */
mov x0, x30 /* arg1: return address in caller */
TSAN_SETUP_C_CALL
- bl G(__tsan_func_entry)
+ bl G(caml_tsan_func_entry_asm)
TSAN_CLEANUP_AFTER_C_CALL
ldr x0, [sp], 16
CFI_ADJUST(-16)
OCaml stack, and we are back to a C stack at this point. */
str x0, [sp, -16]!
CFI_ADJUST(16)
- mov x0, xzr
TSAN_SETUP_C_CALL
- bl G(__tsan_func_exit)
+ bl G(caml_tsan_func_exit_asm)
TSAN_CLEANUP_AFTER_C_CALL
ldr x0, [sp], 16
CFI_ADJUST(-16)
stp x2, x30, [sp, -16]!
CFI_ADJUST(16)
mov x0, x30 /* return address */
- bl G(__tsan_func_entry)
+ bl G(caml_tsan_func_entry_asm)
ldp x2, x30, [sp], 16
CFI_ADJUST(-16)
ldp x0, x1, [sp], 16
stp x2, x30, [sp, -16]!
CFI_ADJUST(16)
mov x0, x30 /* return address */
- bl G(__tsan_func_entry)
+ bl G(caml_tsan_func_entry_asm)
ldp x2, x30, [sp], 16
CFI_ADJUST(-16)
ldp x0, x1, [sp], 16
stp x2, x30, [sp, -16]!
CFI_ADJUST(16)
mov x0, x30 /* return address */
- bl G(__tsan_func_entry)
+ bl G(caml_tsan_func_entry_asm)
ldp x2, x30, [sp], 16
CFI_ADJUST(-16)
ldp x0, x1, [sp], 16
CAMLexport uintnat caml_ba_deserialize(void * dst)
{
struct caml_ba_array * b = dst;
- uintnat num_elts, size;
+ uintnat num_elts, size, descriptor_size;
/* Read back header information */
- b->num_dims = caml_deserialize_uint_4();
- if (b->num_dims < 0 || b->num_dims > CAML_BA_MAX_NUM_DIMS)
+ int num_dims = caml_deserialize_uint_4();
+ if (num_dims < 0 || num_dims > CAML_BA_MAX_NUM_DIMS)
caml_deserialize_error("input_value: wrong number of bigarray dimensions");
+ descriptor_size = SIZEOF_BA_ARRAY + num_dims * sizeof(intnat);
+ if (descriptor_size > Bsize_custom_data(dst))
+ caml_deserialize_error("input_value: bigarray buffer overflow");
+ b->num_dims = num_dims;
b->flags = caml_deserialize_uint_4() | CAML_BA_MANAGED;
b->proxy = NULL;
for (int i = 0; i < b->num_dims; i++) {
caml_ba_deserialize_longarray(b->data, num_elts); break;
default: CAMLunreachable();
}
- /* PR#5516: use C99's flexible array types if possible */
- return SIZEOF_BA_ARRAY + b->num_dims * sizeof(intnat);
+ return descriptor_size;
}
/* Allocate a bigarray from OCaml */
#define Custom_ops_val(v) (*((const struct custom_operations **) (v)))
+/* Given a pointer [p] to the data part of a custom block
+ (as returned by [Data_custom_val]), return the size of this data part
+ (in words or in bytes). */
+#define Wsize_custom_data(p) (Wosize_hp((header_t *)(p) - 2) - 1)
+#define Bsize_custom_data(p) (Bsize_wsize(Wsize_custom_data(p)))
+
#ifdef __cplusplus
extern "C" {
#endif
Each byte carries 7 bits of the number.
Bytes come in big-endian order: xxxxxxx are the 7 high-order bits,
zzzzzzzz the 7 low-order bits.
+
+ The header size is stored in a 6-bit field, so it's 63 at most.
*/
-#define MAX_INTEXT_HEADER_SIZE 55
+#define MAX_INTEXT_HEADER_SIZE 63
/* Codes for the compact format */
CAMLextern value caml_input_val_from_string (value str, intnat ofs);
/* Read a structured value from the OCaml string [str], starting
at offset [ofs]. */
-CAMLextern value caml_input_value_from_malloc(char * data, intnat ofs);
- /* Read a structured value from a malloced buffer. [data] points
- to the beginning of the buffer, and [ofs] is the offset of the
- beginning of the externed data in this buffer. The buffer is
- deallocated with [free] on return, or if an exception is raised. */
+CAMLextern value caml_input_value_from_malloc(char * data, intnat ofs,
+ uintnat len);
+ /* Read a structured value from a malloced buffer. [data] points to the
+ beginning of the buffer, [ofs] is the offset of the beginning of the
+ externed data in this buffer, and [len] is the length in bytes of valid
+ data in this buffer. The buffer is deallocated with [free] on return,
+ or if an exception is raised. */
CAMLextern value caml_input_value_from_block(const char * data, intnat len);
/* Read a structured value from a user-provided buffer. [data] points
to the beginning of the externed data in this buffer,
#undef HAVE_LABELS_AS_VALUES
+#undef HAVE___TSAN_FUNC_EXIT_VOID_VOID_P
+#undef HAVE___TSAN_FUNC_EXIT_VOID_VOID
+
/* Define if the C compiler supports the labels as values extension. */
CAMLextern void caml_tsan_entry_on_resume(uintnat pc, char* sp,
struct stack_info const* stack);
+
+#if defined(WITH_THREAD_SANITIZER)
+
+// __tsan_func_exit can have either of the 2 signatures (#14082)
+#if defined(HAVE___TSAN_FUNC_EXIT_VOID_VOID_P)
extern void __tsan_func_exit(void*);
+#elif defined(HAVE___TSAN_FUNC_EXIT_VOID_VOID)
+extern void __tsan_func_exit(void);
+#endif
+
extern void __tsan_func_entry(void*);
void __tsan_write8(void *location);
+CAMLno_tsan Caml_inline void caml_tsan_func_exit(void) {
+#if defined(HAVE___TSAN_FUNC_EXIT_VOID_VOID_P)
+ __tsan_func_exit(NULL);
+#elif defined(HAVE___TSAN_FUNC_EXIT_VOID_VOID)
+ __tsan_func_exit();
+ #endif
+}
+
+CAMLno_tsan Caml_inline void caml_tsan_func_entry(void *retaddr) {
+ __tsan_func_entry(retaddr);
+}
+
+CAMLno_tsan Caml_inline void caml_tsan_write8(void *location) {
+ __tsan_write8(location);
+}
+
+#endif /* WITH_THREAD_SANITIZER */
+
#endif /* CAML_INTERNALS */
#endif /* CAML_TSAN_H */
const unsigned char * intern_src;
/* Reading pointer in block holding input data. */
+ const unsigned char * intern_src_end;
+ /* Pointer to the end of the readable data. */
+
unsigned char * intern_input;
/* Pointer to beginning of block holding input data,
if non-NULL this pointer will be freed by the cleanup function.
value * intern_obj_table;
/* The pointers to objects already seen */
+ uintnat intern_num_objects;
+ /* How many objects are expected (from the header) */
+
struct intern_item intern_stack_init[INTERN_STACK_INIT_SIZE];
/* The initial intern stack */
/* Writing pointer in destination block. Only used when the object fits in
the minor heap. */
+ header_t * intern_dest_end;
+
char compressed;
/* 1 if the compressed format is in use, 0 otherwise */
};
s = caml_stat_alloc(sizeof(struct caml_intern_state));
s->intern_src = NULL;
+ s->intern_src_end = NULL;
s->intern_input = NULL;
s->obj_counter = 0;
+ s->intern_num_objects = 0;
s->intern_obj_table = NULL;
s->intern_dest = NULL;
+ s->intern_dest_end = NULL;
init_intern_stack(s);
Caml_state->intern_state = s;
}
}
+CAMLnoret static void intern_cleanup_failwith(struct caml_intern_state* s, const char * msg);
static char * intern_resolve_code_pointer(unsigned char digest[16],
asize_t offset);
CAMLnoret static void intern_bad_code_pointer(unsigned char digest[16]);
+Caml_inline void intern_check_read(struct caml_intern_state* s, uintnat len)
+{
+ if (CAMLunlikely(len > s->intern_src_end - s->intern_src)) {
+ intern_cleanup_failwith(s, "input_value: invalid read");
+ }
+}
+
+Caml_inline void intern_record_obj(struct caml_intern_state* s, value v)
+{
+ if (s->intern_obj_table != NULL) {
+ if (CAMLunlikely(s->obj_counter >= s->intern_num_objects)) {
+ intern_cleanup_failwith(s, "input_value: too many objects");
+ }
+ s->intern_obj_table[s->obj_counter++] = v;
+ }
+}
+
Caml_inline unsigned char read8u(struct caml_intern_state* s)
-{ return *s->intern_src++; }
+{
+ intern_check_read(s, 1);
+ return *s->intern_src++;
+}
Caml_inline signed char read8s(struct caml_intern_state* s)
-{ return *s->intern_src++; }
+{
+ intern_check_read(s, 1);
+ return *s->intern_src++;
+}
Caml_inline uint16_t read16u(struct caml_intern_state* s)
{
+ intern_check_read(s, 2);
uint16_t res = (s->intern_src[0] << 8) + s->intern_src[1];
s->intern_src += 2;
return res;
Caml_inline int16_t read16s(struct caml_intern_state* s)
{
+ intern_check_read(s, 2);
int16_t res = (s->intern_src[0] << 8) + s->intern_src[1];
s->intern_src += 2;
return res;
Caml_inline uint32_t read32u(struct caml_intern_state* s)
{
+ intern_check_read(s, 4);
uint32_t res =
((uint32_t)(s->intern_src[0]) << 24) + (s->intern_src[1] << 16)
+ (s->intern_src[2] << 8) + s->intern_src[3];
Caml_inline int32_t read32s(struct caml_intern_state* s)
{
+ intern_check_read(s, 4);
int32_t res =
((uint32_t)(s->intern_src[0]) << 24) + (s->intern_src[1] << 16)
+ (s->intern_src[2] << 8) + s->intern_src[3];
#ifdef ARCH_SIXTYFOUR
static uintnat read64u(struct caml_intern_state* s)
{
+ intern_check_read(s, 8);
uintnat res =
((uintnat) (s->intern_src[0]) << 56)
+ ((uintnat) (s->intern_src[1]) << 48)
}
Caml_inline void readblock(struct caml_intern_state* s,
- void * dest, intnat len)
+ void * dest, uintnat len)
{
+ intern_check_read(s, len);
memcpy(dest, s->intern_src, len);
s->intern_src += len;
}
static void intern_init(struct caml_intern_state* s, const void * src,
- void * input)
+ uintnat len, void * input)
{
CAMLassert (s);
/* This is asserted at the beginning of demarshaling primitives.
CAMLassert(s->intern_input == NULL);
CAMLassert(s->intern_obj_table == NULL);
s->intern_src = src;
+ s->intern_src_end = s->intern_src + len;
s->intern_input = input;
}
if (s->intern_obj_table != NULL) {
caml_stat_free(s->intern_obj_table);
s->intern_obj_table = NULL;
+ s->intern_num_objects = 0;
}
s->intern_dest = NULL;
+ s->intern_dest_end = NULL;
/* free the recursion stack */
intern_free_stack(s);
}
caml_failwith_value(caml_alloc_sprintf("%s: %s", fun_name, msg));
}
+CAMLnoret static void
+intern_cleanup_failwith(struct caml_intern_state* s, const char * msg)
+{
+ intern_cleanup(s);
+ caml_failwith(msg);
+}
+
+CAMLnoret static void
+intern_cleanup_failwith2(struct caml_intern_state* s, const char * fun_name,
+ const char * msg)
+{
+ intern_cleanup(s);
+ intern_failwith2(fun_name, msg);
+}
+
CAMLnoret static void
intern_cleanup_failwith3(struct caml_intern_state* s, const char * fun_name,
const char * msg, const char * arg)
* individual block allocations are tracked instead */
Alloc_small(v, wosize, String_tag, Alloc_small_enter_GC_no_track);
s->intern_dest = (header_t *) Hp_val(v);
+ s->intern_dest_end = s->intern_dest + whsize;
} else {
CAMLassert (s->intern_dest == NULL);
}
+ s->intern_num_objects = num_objects;
s->obj_counter = 0;
if (num_objects > 0) {
s->intern_obj_table =
- (value *) caml_stat_alloc_noexc(num_objects * sizeof(value));
+ (value *) caml_stat_calloc_noexc(num_objects, sizeof(value));
if (s->intern_obj_table == NULL) {
intern_cleanup(s);
caml_raise_out_of_memory();
{
void* p;
+ if (CAMLunlikely(wosize > Max_wosize)) {
+ intern_cleanup_failwith(s, "input_value: block size too large");
+ }
if (s->intern_dest) {
CAMLassert ((value*)s->intern_dest >= d->young_start &&
(value*)s->intern_dest < d->young_end);
+ if (CAMLunlikely(wosize >= s->intern_dest_end - s->intern_dest)) {
+ intern_cleanup_failwith(s, "input_value: invalid allocation");
+ }
p = s->intern_dest;
*s->intern_dest = Make_header (wosize, tag, 0);
caml_memprof_sample_block(Val_hp(p), wosize, 1 + wosize,
/* Pop item and iterate */
sp--;
break;
- case OShift:
+ case OShift: {
/* Shift value by an offset */
- *dest += sp->arg;
+ value v = *dest;
+ intnat ofs = sp->arg;
+ if (Is_block(v)
+ && (uintnat) ofs % sizeof(value) == 0
+ && ofs >= 0 && ofs < Bosize_val(v)
+ && Tag_val(v + ofs) == Infix_tag
+ && Infix_offset_val(v + ofs) == ofs)
+ *dest = v + ofs;
+ else
+ intern_cleanup_failwith2(s, fun_name, "bad infix offset");
+ }
/* Pop item and iterate */
sp--;
break;
v = Atom(tag);
} else {
v = intern_alloc_obj (s, d, size, tag);
- if (s->intern_obj_table != NULL)
- s->intern_obj_table[s->obj_counter++] = v;
+ intern_record_obj(s, v);
/* For objects, we need to freshen the oid */
if (tag == Object_tag) {
- CAMLassert(size >= 2);
+ if (CAMLunlikely(size < 2))
+ intern_cleanup_failwith2(s, fun_name, "bad object block");
/* Request to read rest of the elements of the block */
ReadItems(s, &Field(v, 2), size - 2);
/* Request freshing OID */
/* Small string */
len = (code & 0x1F);
read_string:
+ if (CAMLunlikely(len > Bsize_wsize (Max_wosize) - 1))
+ intern_cleanup_failwith2(s, fun_name, "string too large");
size = (len + sizeof(value)) / sizeof(value);
v = intern_alloc_obj (s, d, size, String_tag);
- if (s->intern_obj_table != NULL)
- s->intern_obj_table[s->obj_counter++] = v;
+ intern_record_obj(s, v);
Field(v, size - 1) = 0;
ofs_ind = Bsize_wsize(size) - 1;
Byte(v, ofs_ind) = ofs_ind - len;
v = Val_long((intnat) (read64u(s)));
break;
#else
- intern_cleanup(s);
- intern_failwith2(fun_name, "integer too large");
+ intern_cleanup_failwith2(s, fun_name, "integer too large");
break;
#endif
case CODE_SHARED8:
ofs = read8u(s);
read_shared:
if (!s->compressed) ofs = s->obj_counter - ofs;
- CAMLassert (ofs < s->obj_counter);
- CAMLassert (s->intern_obj_table != NULL);
+ /* If intern_obj_table is NULL, obj_counter is 0 and the check fails */
+ if (CAMLunlikely(ofs >= s->obj_counter)) {
+ intern_cleanup_failwith2(s, fun_name, "invalid shared reference");
+ }
v = s->intern_obj_table[ofs];
break;
case CODE_SHARED16:
header = (header_t) read32u(s);
tag = Tag_hd(header);
size = Wosize_hd(header);
+ if (CAMLunlikely(tag >= No_scan_tag
+ || tag == Infix_tag || tag == Cont_tag))
+ intern_cleanup_failwith2(s, fun_name, "invalid block32");
goto read_block;
#ifdef ARCH_SIXTYFOUR
case CODE_BLOCK64:
header = (header_t) read64u(s);
tag = Tag_hd(header);
size = Wosize_hd(header);
+ if (CAMLunlikely(tag >= No_scan_tag
+ || tag == Infix_tag || tag == Cont_tag))
+ intern_cleanup_failwith2(s, fun_name, "invalid block64");
goto read_block;
#endif
case CODE_STRING8:
case CODE_DOUBLE_LITTLE:
case CODE_DOUBLE_BIG:
v = intern_alloc_obj (s, d, Double_wosize, Double_tag);
- if (s->intern_obj_table != NULL)
- s->intern_obj_table[s->obj_counter++] = v;
+ intern_record_obj(s, v);
readfloat(s, (double *) v, code);
break;
case CODE_DOUBLE_ARRAY8_LITTLE:
case CODE_DOUBLE_ARRAY8_BIG:
len = read8u(s);
read_double_array:
+ if (len == 0)
+ intern_cleanup_failwith2(s, fun_name, "invalid double_array");
size = len * Double_wosize;
v = intern_alloc_obj (s, d, size, Double_array_tag);
- if (s->intern_obj_table != NULL)
- s->intern_obj_table[s->obj_counter++] = v;
+ intern_record_obj(s, v);
readfloats(s, (double *) v, len, code);
break;
case CODE_DOUBLE_ARRAY32_LITTLE:
ReadItems(s, dest, 1);
continue; /* with next iteration of main loop, skipping *dest = v */
case OLD_CODE_CUSTOM:
- intern_cleanup(s);
- intern_failwith2(fun_name, "custom blocks serialized with "
- "OCaml 4.08.0 (or prior) are no longer supported");
+ intern_cleanup_failwith2(s, fun_name, "custom blocks serialized with "
+ "OCaml 4.08.0 (or prior) are no longer supported");
break;
case CODE_CUSTOM_LEN:
case CODE_CUSTOM_FIXED: {
uintnat expected_size, temp_size;
const char * name = (const char *) s->intern_src;
+ const unsigned char * name_end =
+ memchr(name, 0, s->intern_src_end - s->intern_src);
+ if (name_end == NULL) {
+ intern_cleanup_failwith2(s, fun_name, "unterminated custom block identifier");
+ }
ops = caml_find_custom_operations(name);
if (ops == NULL) {
intern_cleanup_failwith3
(s, fun_name, "unknown custom block identifier", name);
}
- if (code == CODE_CUSTOM_FIXED && ops->fixed_length == NULL) {
+ if ((code == CODE_CUSTOM_FIXED) != (ops->fixed_length != NULL)) {
intern_cleanup_failwith3
- (s, fun_name, "expected a fixed-size custom block", name);
+ (s, fun_name, "wrong custom block kind", name);
}
- while (*s->intern_src++ != 0) /*nothing*/; /*skip identifier*/
+ s->intern_src = name_end + 1; /*skip identifier*/
#ifdef ARCH_SIXTYFOUR
if (code == CODE_CUSTOM_FIXED) {
expected_size = ops->fixed_length->bsize_64;
} else {
+ intern_check_read(s, 4);
s->intern_src += 4;
expected_size = read64u(s);
}
expected_size = ops->fixed_length->bsize_32;
} else {
expected_size = read32u(s);
+ intern_check_read(s, 8);
s->intern_src += 8;
}
#endif
temp_size = 1 + (expected_size + sizeof(value) - 1) / sizeof(value);
- v = intern_alloc_obj(s, d, temp_size, Custom_tag);
+ v = intern_alloc_obj(s, d, temp_size, Abstract_tag);
Custom_ops_val(v) = ops;
size = ops->deserialize(Data_custom_val(v));
if (size != expected_size) {
intern_cleanup_failwith3
(s, fun_name, "error while deserializing custom block", name);
}
- if (s->intern_obj_table != NULL)
- s->intern_obj_table[s->obj_counter++] = v;
+ Unsafe_store_tag_val(v, Custom_tag);
+ intern_record_obj(s, v);
if (ops->finalize != NULL && Is_young(v)) {
/* Remember that the block has a finalizer. */
add_to_custom_table (&d->minor_tables->custom, v, 0, 1);
break;
}
default:
- intern_cleanup(s);
- intern_failwith2(fun_name, "ill-formed message");
+ intern_cleanup_failwith2(s, fun_name, "ill-formed message");
}
}
}
h->data_len);
if (res != h->uncompressed_data_len) {
free(blk);
- intern_cleanup(s);
- intern_failwith2(fun_name, "decompression error");
+ intern_cleanup_failwith2(s, fun_name, "decompression error");
}
if (s->intern_input != NULL) free(s->intern_input);
s->intern_input = blk; /* to be freed at end of demarshaling */
s->intern_src = blk;
+ s->intern_src_end = s->intern_src + h->uncompressed_data_len;
} else {
- intern_cleanup(s);
- intern_failwith2(fun_name, "compressed object, cannot decompress");
+ intern_cleanup_failwith2(s, fun_name, "compressed object, cannot decompress");
}
}
else if (r < 5)
caml_failwith("input_value: truncated object");
s->intern_src = (unsigned char *) header;
+ s->intern_src_end = s->intern_src + 5;
int hlen;
switch (read32u(s)) {
case Intext_magic_number_big:
hlen = 20; break;
}
/* Read the remainder of the header */
- CAMLassert (hlen > 5);
- if (caml_really_getblock(chan, header + 5, hlen - 5) < hlen - 5)
+ if (hlen <= 5
+ || caml_really_getblock(chan, header + 5, hlen - 5) < hlen - 5)
caml_failwith("input_value: truncated object");
/* Parse the full header */
s->intern_src = (unsigned char *) header;
+ s->intern_src_end = s->intern_src + hlen;
caml_parse_header(s, "input_value", &h);
/* Read block from channel */
/* During channel I/O, concurrent [caml_input_val] operations
caml_failwith("input_value: truncated object");
}
/* Initialize global state */
- intern_init(s, block, block);
+ intern_init(s, block, h.data_len, block);
intern_decompress_input(s, "input_value", &h);
intern_alloc_storage(s, h.whsize, h.num_objects);
/* Fill it in - obj must NOT be registered as a GC root */
struct caml_intern_state* s = init_intern_state ();
/* Initialize global state */
- intern_init(s, &Byte_u(str, ofs), NULL);
+ intern_init(s, &Byte_u(str, ofs), caml_string_length(str) - ofs, NULL);
caml_parse_header(s, "input_val_from_string", &h);
if (ofs + h.header_len + h.data_len > caml_string_length(str))
caml_failwith("input_val_from_string: bad length");
/* Allocate result */
intern_alloc_storage(s, h.whsize, h.num_objects);
s->intern_src = &Byte_u(str, ofs + h.header_len); /* If a GC occurred */
+ s->intern_src_end = s->intern_src + h.data_len;
/* Decompress if needed */
intern_decompress_input(s, "input_val_from_string", &h);
/* Fill it in - obj must NOT be registered as a GC root */
return (intern_end(s, obj));
}
-CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs)
+/* [len] is a number of bytes */
+static value caml_input_value_from_buffer(const char * fun_name,
+ const char * src,
+ uintnat len, void * input)
{
struct marshal_header h;
struct caml_intern_state* s = init_intern_state ();
- intern_init(s, data + ofs, data);
- caml_parse_header(s, "input_value_from_malloc", &h);
+ intern_init(s, src, len, input);
+ caml_parse_header(s, fun_name, &h);
+ if (h.header_len + h.data_len > len)
+ intern_failwith2(fun_name, "bad length");
+ s->intern_src_end = s->intern_src + h.data_len;
return input_val_from_block(s, &h);
}
-/* [len] is a number of bytes */
-CAMLexport value caml_input_value_from_block(const char * data, intnat len)
+CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs,
+ uintnat len)
{
- struct marshal_header h;
- struct caml_intern_state* s = init_intern_state ();
+ return caml_input_value_from_buffer
+ ("input_value_from_malloc", data + ofs, len, data);
+}
- /* Initialize global state */
- intern_init(s, data, NULL);
- caml_parse_header(s, "input_value_from_block", &h);
- if (h.header_len + h.data_len > len)
- caml_failwith("input_val_from_block: bad length");
- return input_val_from_block(s, &h);
+CAMLexport value caml_input_value_from_block(const char * data, intnat len)
+{
+ if (len < 0)
+ caml_failwith("input_value_from_block: negative length");
+ return caml_input_value_from_buffer
+ ("input_value_from_block", data, len, NULL);
}
/* [ofs] is a [value] that represents a number of bytes
struct caml_intern_state *s = init_intern_state ();
s->intern_src = &Byte_u(buff, Long_val(ofs));
+ s->intern_src_end = &Byte_u(buff, caml_string_length(buff));
magic = read32u(s);
switch(magic) {
case Intext_magic_number_small:
CAMLexport void caml_deserialize_block_1(void * data, intnat len)
{
struct caml_intern_state* s = get_intern_state ();
+ intern_check_read(s, len);
memcpy(data, s->intern_src, len);
s->intern_src += len;
}
CAMLexport void caml_deserialize_block_2(void * data, intnat len)
{
struct caml_intern_state* s = get_intern_state ();
+ intern_check_read(s, len * 2);
#ifndef ARCH_BIG_ENDIAN
const unsigned char * p, * q;
for (p = s->intern_src, q = data; len > 0; len--, p += 2, q += 2)
CAMLexport void caml_deserialize_block_4(void * data, intnat len)
{
struct caml_intern_state* s = get_intern_state ();
+ intern_check_read(s, len * 4);
#ifndef ARCH_BIG_ENDIAN
const unsigned char * p, * q;
for (p = s->intern_src, q = data; len > 0; len--, p += 4, q += 4)
CAMLexport void caml_deserialize_block_8(void * data, intnat len)
{
struct caml_intern_state* s = get_intern_state ();
+ intern_check_read(s, len * 8);
#ifndef ARCH_BIG_ENDIAN
const unsigned char * p, * q;
for (p = s->intern_src, q = data; len > 0; len--, p += 8, q += 8)
CAMLexport void caml_deserialize_block_float_8(void * data, intnat len)
{
struct caml_intern_state* s = get_intern_state ();
+ intern_check_read(s, len * 8);
#if ARCH_FLOAT_ENDIANNESS == 0x01234567
memcpy(data, s->intern_src, len * 8);
s->intern_src += len * 8;
CAMLexport void caml_deserialize_error(const char * msg)
{
struct caml_intern_state* s = get_intern_state ();
- intern_cleanup(s);
- caml_failwith(msg);
+ intern_cleanup_failwith(s, msg);
}
CAMLexport CAMLweakdef void caml_modify (volatile value *fp, value val)
{
#if defined(WITH_THREAD_SANITIZER) && defined(NATIVE_CODE)
- __tsan_func_entry(__builtin_return_address(0));
+ caml_tsan_func_entry(__builtin_return_address(0));
#endif
write_barrier((value)fp, 0, *fp, val);
* CAMLno_tsan. We signal it to ThreadSanitizer as a plain store (see
* ocaml-multicore/ocaml-tsan/pull/22#issuecomment-1377439074 on Github).
*/
- __tsan_write8((void *)fp);
- __tsan_func_exit(NULL);
+ caml_tsan_write8((void *)fp);
+ caml_tsan_func_exit();
#endif
atomic_store_release(&Op_atomic_val((value)fp)[0], val);
SWITCH_OCAML_TO_C
TSAN_SETUP_C_CALL 0
mr 3, 0 /* arg1: return address in caller */
- Far_call(__tsan_func_entry)
+ Far_call(caml_tsan_func_entry_asm)
TSAN_CLEANUP_AFTER_C_CALL 0
SWITCH_C_TO_OCAML
.endm
Far_call(caml_garbage_collection)
#if defined(WITH_THREAD_SANITIZER)
TSAN_SETUP_C_CALL 0
- li 3, 0
- Far_call(__tsan_func_exit)
+ Far_call(caml_tsan_func_exit_asm)
TSAN_CLEANUP_AFTER_C_CALL 0
#endif
SWITCH_C_TO_OCAML
it may have returned its result (if any) either in r3 or f1. */
std 3, (RESERVED_STACK + 0)(SP)
stfd 1, (RESERVED_STACK + 8)(SP)
- li 3, 0
- Far_call(__tsan_func_exit)
+ Far_call(caml_tsan_func_exit_asm)
lfd 1, (RESERVED_STACK + 8)(SP)
ld 3, (RESERVED_STACK + 0)(SP)
TSAN_CLEANUP_AFTER_C_CALL 16
TSAN_SETUP_C_CALL 16
std 3, (RESERVED_STACK + 0)(SP)
mr 3, 0 /* arg1: return address in caller */
- Far_call(__tsan_func_entry)
+ Far_call(caml_tsan_func_entry_asm)
ld 3, (RESERVED_STACK + 0)(SP)
TSAN_CLEANUP_AFTER_C_CALL 16
#endif
#if defined(WITH_THREAD_SANITIZER)
TSAN_SETUP_C_CALL 16
std 3, (RESERVED_STACK + 0)(SP)
- li 3, 0
- Far_call(__tsan_func_exit)
+ Far_call(caml_tsan_func_exit_asm)
ld 3, (RESERVED_STACK + 0)(SP)
TSAN_CLEANUP_AFTER_C_CALL 16
#endif
std 4, (RESERVED_STACK + 8)(SP)
std 5, (RESERVED_STACK + 16)(SP)
mr 3, 0 /* return address */
- Far_call(__tsan_func_entry)
+ Far_call(caml_tsan_func_entry_asm)
ld 5, (RESERVED_STACK + 16)(SP)
ld 4, (RESERVED_STACK + 8)(SP)
ld 3, (RESERVED_STACK + 0)(SP)
std 4, (RESERVED_STACK + 8)(SP)
std 5, (RESERVED_STACK + 16)(SP)
mr 3, 0 /* return address */
- Far_call(__tsan_func_entry)
+ Far_call(caml_tsan_func_entry_asm)
ld 5, (RESERVED_STACK + 16)(SP)
ld 4, (RESERVED_STACK + 8)(SP)
ld 3, (RESERVED_STACK + 0)(SP)
std 4, (RESERVED_STACK + 8)(SP)
std 5, (RESERVED_STACK + 16)(SP)
mr 3, 0 /* return address */
- Far_call(__tsan_func_entry)
+ Far_call(caml_tsan_func_entry_asm)
ld 5, (RESERVED_STACK + 16)(SP)
ld 4, (RESERVED_STACK + 8)(SP)
ld 3, (RESERVED_STACK + 0)(SP)
std 7, (RESERVED_STACK + 32)(SP)
std 8, (RESERVED_STACK + 40)(SP)
/* Match the TSan-enter made from caml_runstack */
- li 3, 0
- Far_call(__tsan_func_exit)
+ Far_call(caml_tsan_func_exit_asm)
ld 8, (RESERVED_STACK + 40)(SP)
ld 7, (RESERVED_STACK + 32)(SP)
ld 6, (RESERVED_STACK + 24)(SP)
Far_call(caml_tsan_entry_on_resume)
/* invoke __tsan_func_entry without shuffling stacks */
ld 3, LR_SAVE(SP)
- Far_call(__tsan_func_entry)
+ Far_call(caml_tsan_func_entry_asm)
TSAN_CLEANUP_AFTER_C_CALL 0
SWITCH_C_TO_OCAML
TSAN_RESTORE_CALLER_REGS
std 3, (RESERVED_STACK + 0)(SP)
/* Necessary to include the caller of caml_resume in the TSan backtrace */
mr 3, 0 /* arg1: return address in caller */
- Far_call(__tsan_func_entry)
+ Far_call(caml_tsan_func_entry_asm)
/* Signal to TSan all stack frames exited by the perform. */
ld 3, (RESERVED_STACK + 0)(SP)
mr 5, 3 /* arg3: fiber */
std 5, (RESERVED_STACK + 16)(SP)
/* Necessary to include the caller of caml_runstack in the TSan backtrace */
mr 3, 0 /* arg1: return address in caller */
- Far_call(__tsan_func_entry)
+ Far_call(caml_tsan_func_entry_asm)
ld 5, (RESERVED_STACK + 16)(SP)
ld 4, (RESERVED_STACK + 8)(SP)
ld 3, (RESERVED_STACK + 0)(SP)
mr SP, 27 /* OCaml stack */
#if defined(WITH_THREAD_SANITIZER)
/* Signal to TSan that we exit caml_runstack (no registers to save here) */
- li 3, 0
SWITCH_OCAML_TO_C
TSAN_SETUP_C_CALL 0
- Far_call(__tsan_func_exit)
+ Far_call(caml_tsan_func_exit_asm)
TSAN_CLEANUP_AFTER_C_CALL 0
SWITCH_C_TO_OCAML
#endif
SWITCH_C_TO_OCAML
.endm
-/* Invoke __tsan_func_entry(return address in the caller) */
+/* Invoke caml_tsan_func_entry_asm (return address in the caller) */
.macro TSAN_ENTER_FUNCTION
mv a0, ra /* arg1: return address in caller */
- TSAN_C_CALL __tsan_func_entry
+ TSAN_C_CALL caml_tsan_func_entry_asm
.endm
-/* Invoke __tsan_func_exit(0) */
+/* Invoke caml_tsan_func_exit_asm */
.macro TSAN_EXIT_FUNCTION
- mv a0, x0
- TSAN_C_CALL __tsan_func_exit
+ TSAN_C_CALL caml_tsan_func_exit_asm
.endm
/* This is similar to SAVE_ALL_REGS, but only saving the caller-saved
ld TRAP_PTR, Caml_state(exn_handler)
.endm
+.macro TSAN_PUSH_RETURN_REGS
+ addi sp, sp, -32
+ CFI_ADJUST(32)
+ sd a0, 0(sp)
+ fsd fa0, 16(sp)
+ fsd fa1, 24(sp)
+.endm
+
+.macro TSAN_POP_RETURN_REGS
+ fld fa1, 24(sp)
+ fld fa0, 16(sp)
+ ld a0, 0(sp)
+ addi sp, sp, 32
+ CFI_ADJUST(-32)
+.endm
+
#else /* } { */
.macro TSAN_ENTER_FUNCTION
.macro TSAN_RESTORE_CALLER_REGS
.endm
+.macro TSAN_PUSH_RETURN_REGS
+.endm
+
+.macro TSAN_POP_RETURN_REGS
+.endm
+
#endif /* } WITH_THREAD_SANITIZER */
/* Allocation functions and GC interface.
ld TRAP_PTR, Caml_state(exn_handler)
/* Load ocaml stack */
SWITCH_C_TO_OCAML
-#if defined(WITH_THREAD_SANITIZER)
- /* Save return value registers. Since the called function could be
- anything, it may have returned its result (if any) either in a0
- or fa0:fa1. */
- addi sp, sp, -32
- CFI_ADJUST(32)
- sd a0, 0(sp)
- fsd fa0, 16(sp)
- fsd fa1, 24(sp)
+ TSAN_PUSH_RETURN_REGS /* Save return value. */
TSAN_EXIT_FUNCTION
- /* Restore return value registers */
- fld fa1, 24(sp)
- fld fa0, 16(sp)
- ld a0, 0(sp)
- addi sp, sp, 32
- CFI_ADJUST(-32)
-#endif
+ TSAN_POP_RETURN_REGS
/* Return */
LEAVE_FUNCTION
RET_FROM_C_CALL
C stack args : begin=STACK_ARG_BEGIN
end=STACK_ARG_END */
ENTER_FUNCTION
+ TSAN_SAVE_CALLER_REGS
+ TSAN_ENTER_FUNCTION
+ TSAN_RESTORE_CALLER_REGS
/* Switch from OCaml to C */
SWITCH_OCAML_TO_C
/* Make the exception handler alloc ptr available to the C code */
ld TRAP_PTR, Caml_state(exn_handler)
/* Switch from C to OCaml */
SWITCH_C_TO_OCAML
+ TSAN_PUSH_RETURN_REGS /* Save return value. */
+ TSAN_EXIT_FUNCTION
+ TSAN_POP_RETURN_REGS
/* Return */
LEAVE_FUNCTION
RET_FROM_C_CALL
on an OCaml stack, yet we are still on a C stack at this point. */
mv a0, ra
ENTER_FUNCTION
- call PLT(__tsan_func_entry)
+ call PLT(caml_tsan_func_entry_asm)
LEAVE_FUNCTION
ld a0, 0(sp)
addi sp, sp, 16
addi sp, sp, -16
CFI_ADJUST(16)
sd a0, 0(sp)
- mv a0, x0
ENTER_FUNCTION
- call PLT(__tsan_func_exit)
+ call PLT(caml_tsan_func_exit_asm)
LEAVE_FUNCTION
ld a0, 0(sp)
addi sp, sp, 16
sd a2, 16(sp)
sd ra, 24(sp)
mv a0, ra
- call PLT(__tsan_func_entry)
+ call PLT(caml_tsan_func_entry_asm)
ld ra, 24(sp)
ld a2, 16(sp)
ld a1, 8(sp)
sd a2, 16(sp)
sd ra, 24(sp)
mv a0, ra
- call PLT(__tsan_func_entry)
+ call PLT(caml_tsan_func_entry_asm)
ld ra, 24(sp)
ld a2, 16(sp)
ld a1, 8(sp)
sd a2, 16(sp)
sd ra, 24(sp)
mv a0, ra
- call PLT(__tsan_func_entry)
+ call PLT(caml_tsan_func_entry_asm)
ld ra, 24(sp)
ld a2, 16(sp)
ld a1, 8(sp)
TSAN_CLEANUP_AFTER_C_CALL; \
SWITCH_C_TO_OCAML
-/* Invoke __tsan_func_entry(return address in the caller) */
+/* Invoke caml_tsan_func_entry_asm (return address in the caller) */
#define TSAN_ENTER_FUNCTION \
lgr C_ARG_1, %r14; /* arg1: return address in caller */ \
- TSAN_C_CALL(__tsan_func_entry)
+ TSAN_C_CALL(caml_tsan_func_entry_asm)
-/* Invoke __tsan_func_exit(0) */
+/* Invoke caml_tsan_func_exit_asm */
#define TSAN_EXIT_FUNCTION \
- lgfi C_ARG_1, 0; \
- TSAN_C_CALL(__tsan_func_exit)
+ TSAN_C_CALL(caml_tsan_func_exit_asm)
/* This is similar to SAVE_ALL_REGS, but only saving the caller-saved
registers. */
lg ALLOC_PTR, Caml_state(young_ptr); \
lg TRAP_PTR, Caml_state(exn_handler)
+#define TSAN_PUSH_RETURN_REGS \
+ lay %r15, -16(%r15); \
+ CFI_ADJUST(16); \
+ stg %r2, 0(%r15); \
+ std %f0, 8(%r15)
+
+#define TSAN_POP_RETURN_REGS \
+ ld %f0, 8(%r15); \
+ lg %r2, 0(%r15); \
+ la %r15, 16(%r15); \
+ CFI_ADJUST(-16)
+
#else /* } { */
#define TSAN_ENTER_FUNCTION
#define TSAN_EXIT_FUNCTION
#define TSAN_SAVE_CALLER_REGS
#define TSAN_RESTORE_CALLER_REGS
+#define TSAN_PUSH_RETURN_REGS
+#define TSAN_POP_RETURN_REGS
#endif /* } */
lg TRAP_PTR, Caml_state(exn_handler)
/* Load ocaml stack and restore global variables */
SWITCH_C_TO_OCAML
-#if defined(WITH_THREAD_SANITIZER)
- /* Save return value registers. Since the called function could be
- anything, it may have returned its result (if any) either in %r2
- or %f0. */
- lay %r15, -16(%r15)
- CFI_ADJUST(16)
- stg %r2, 0(%r15)
- std %f0, 8(%r15)
+ TSAN_PUSH_RETURN_REGS /* Save return value. */
TSAN_EXIT_FUNCTION
- /* Restore return value registers */
- ld %f0, 8(%r15)
- lg %r2, 0(%r15)
- la %r15, 16(%r15)
- CFI_ADJUST(-16)
-#endif
+ TSAN_POP_RETURN_REGS
/* Return to OCaml caller */
LEAVE_FUNCTION
RET_FROM_C_CALL
C arguments : %r2, %r3, %r4, %r5, %r6
C function : ADDITIONAL_ARG
C stack args : begin=%r9 end=%r8 */
+#if defined(WITH_THREAD_SANITIZER)
+ /* We can't use TSAN_{SAVE,RESTORE}_CALLER_REGS here as we need to
+ also preserve %r6-%r9. */
+ SAVE_ALL_REGS
+ TSAN_ENTER_FUNCTION
+ RESTORE_ALL_REGS
+#endif
/* Switch from OCaml to C */
SWITCH_OCAML_TO_C
/* Make the exception handler alloc ptr available to the C code */
lg TRAP_PTR, Caml_state(exn_handler)
/* Switch from C to OCaml */
SWITCH_C_TO_OCAML
+ TSAN_PUSH_RETURN_REGS /* Save return value. */
+ TSAN_EXIT_FUNCTION
+ TSAN_POP_RETURN_REGS
/* Return */
LEAVE_FUNCTION
RET_FROM_C_CALL
OCaml stack, yet we are still on a C stack at this point. */
lgr C_ARG_1, %r14
TSAN_SETUP_C_CALL
- brasl %r14, GCALL(__tsan_func_entry)
+ brasl %r14, GCALL(caml_tsan_func_entry_asm)
TSAN_CLEANUP_AFTER_C_CALL
lg C_ARG_1, 0(%r15)
la %r15, 8(%r15)
lay %r15, -8(%r15)
CFI_ADJUST(8)
stg C_ARG_1, 0(%r15)
- lgfi C_ARG_1, 0
TSAN_SETUP_C_CALL
- brasl %r14, GCALL(__tsan_func_exit)
+ brasl %r14, GCALL(caml_tsan_func_exit_asm)
TSAN_CLEANUP_AFTER_C_CALL
lg C_ARG_1, 0(%r15)
la %r15, 8(%r15)
stg C_ARG_3, (RESERVED_STACK+16)(%r15)
stg %r14, (RESERVED_STACK+24)(%r15)
lgr C_ARG_1, %r14
- brasl %r14, GCALL(__tsan_func_entry)
+ brasl %r14, GCALL(caml_tsan_func_entry_asm)
lg %r14, (RESERVED_STACK+24)(%r15)
lg C_ARG_3, (RESERVED_STACK+16)(%r15)
lg C_ARG_2, (RESERVED_STACK+8)(%r15)
stg C_ARG_3, (RESERVED_STACK+16)(%r15)
stg %r14, (RESERVED_STACK+24)(%r15)
lgr C_ARG_1, %r14
- brasl %r14, GCALL(__tsan_func_entry)
+ brasl %r14, GCALL(caml_tsan_func_entry_asm)
lg %r14, (RESERVED_STACK+24)(%r15)
lg C_ARG_3, (RESERVED_STACK+16)(%r15)
lg C_ARG_2, (RESERVED_STACK+8)(%r15)
stg C_ARG_3, (RESERVED_STACK+16)(%r15)
stg %r14, (RESERVED_STACK+24)(%r15)
lgr C_ARG_1, %r14
- brasl %r14, GCALL(__tsan_func_entry)
+ brasl %r14, GCALL(caml_tsan_func_entry_asm)
lg %r14, (RESERVED_STACK+24)(%r15)
lg C_ARG_3, (RESERVED_STACK+16)(%r15)
lg C_ARG_2, (RESERVED_STACK+8)(%r15)
}
caml_tsan_debug_log_pc("forced__tsan_func_exit for", pc);
- __tsan_func_exit(NULL);
+ caml_tsan_func_exit();
pc = next_pc;
}
}
{
unw_context_t uc;
unw_cursor_t cursor;
- unw_word_t sp;
#ifdef TSAN_DEBUG
unw_word_t prev_pc;
#endif
if (ret != 0)
caml_fatal_error("unw_init_local failed with code %d", ret);
- while (1) {
+ unw_word_t initial_sp;
+ ret = unw_get_reg(&cursor, UNW_REG_SP, &initial_sp);
+ if (ret != 0)
+ caml_fatal_error("unw_get_reg SP failed with code %d", ret);
+
+ /* Unwind each call in the stack fragment between `initial_sp` and `limit`. */
+ for(unw_word_t sp = initial_sp; initial_sp <= sp && (char*)sp < limit; ) {
+
#ifdef TSAN_DEBUG
if (unw_get_reg(&cursor, UNW_REG_IP, &prev_pc) < 0) {
caml_fatal_error("unw_get_reg IP failed with code %d", ret);
}
+
+ caml_tsan_debug_log_pc("forced__tsan_func_exit for", prev_pc);
#endif
+ /* Still on the C stack, pop on the TSan shadow stack. */
+ caml_tsan_func_exit();
ret = unw_step(&cursor);
if (ret < 0) {
ret = unw_get_reg(&cursor, UNW_REG_SP, &sp);
if (ret != 0)
caml_fatal_error("unw_get_reg SP failed with code %d", ret);
-#ifdef TSAN_DEBUG
- caml_tsan_debug_log_pc("forced__tsan_func_exit for", prev_pc);
-#endif
- __tsan_func_exit(NULL);
-
- if ((char*)sp >= limit) {
- break;
- }
}
}
}
caml_tsan_debug_log_pc("forced__tsan_func_exit for", pc);
- __tsan_func_exit(NULL);
+ caml_tsan_func_exit();
pc = next_pc;
}
caml_tsan_entry_on_resume(next_pc, sp, stack);
caml_tsan_debug_log_pc("forced__tsan_func_entry for", pc);
- __tsan_func_entry((void*)next_pc);
+ caml_tsan_func_entry((void*)next_pc);
}
#endif // NATIVE_CODE
{
__tsan_write16(ptr);
}
+
+CAMLno_tsan void caml_tsan_func_exit_asm(void) {
+#if defined(HAVE___TSAN_FUNC_EXIT_VOID_VOID_P)
+ __tsan_func_exit(NULL);
+#elif defined(HAVE___TSAN_FUNC_EXIT_VOID_VOID)
+ __tsan_func_exit();
+ #endif
+}
+
+CAMLno_tsan void caml_tsan_func_entry_asm(void *retaddr) {
+ __tsan_func_entry(retaddr);
+}
+
+// caml_tsan_write8 is never used in .S files
Unix.set_nonblock wr;
let buf = Bytes.make 1000 '!' in
begin match
- for i = 1 to 1000 do
+ for i = 1 to 10_000 do
ignore (Unix.write wr buf 0 1000)
done
with
output ch buf 0 1000;
let alarm_handler _ =
(* clear some space *)
- Unix.read rd (Bytes.make 10_000 '?') 0 10_000 |> ignore;
+ Unix.read rd (Bytes.make 100_000 '?') 0 100_000 |> ignore;
close_out ch
in
Sys.signal Sys.sigalrm (Signal_handle alarm_handler) |> ignore;
--- /dev/null
+(* TEST
+ arguments = "-n 10000";
+*)
+
+(* Can also be used with an external fuzzer such as AFL:
+ ./fuzzy -o fuzzy.in/data
+ afl-fuzz -i fuzzy.in -o fuzzy.out -- ./fuzzy -r
+*)
+
+(* Some data to be marshaled *)
+
+type t = A | B of int | C of float | D of string | E of char
+ | F of t | G of t * t | H of int * t | I of t * float | J
+
+let longstring =
+"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
+
+let bigint = Int64.to_int 0x123456789ABCDEF0L
+
+let closures () =
+ let t = true and
+ f = false in
+ let rec odd n =
+ if n = 0
+ then f
+ else even (n-1)
+ and even n =
+ if n = 0
+ then t
+ else odd (n-1)
+ in (even, odd)
+
+let data () = [|
+ Obj.repr 1;
+ Obj.repr (-1);
+ Obj.repr 20000;
+ Obj.repr 0x12345678;
+ Obj.repr bigint;
+ Obj.repr "foo";
+ Obj.repr longstring;
+ Obj.repr 3.141592654;
+ Obj.repr A;
+ Obj.repr (B 1);
+ Obj.repr (C 2.718);
+ Obj.repr (D "hello");
+ Obj.repr (E 'l');
+ Obj.repr (F(B 1));
+ Obj.repr (G(A, G(B 2, G(C 3.14, G(D "", E 'e')))));
+ Obj.repr (H(1, A));
+ Obj.repr (I(B 2, 1e-6));
+ (let x = D "sharing" in
+ let y = G(x, x) in
+ let z = G(y, G(x, y)) in
+ Obj.repr z);
+ Obj.repr [|1;2;3;4;5;6;7;8|];
+ Obj.repr [|3.14; 2.718|];
+ Obj.repr (closures());
+ Obj.repr 0l;
+ Obj.repr 123456l;
+ Obj.repr 0L;
+ (let i = Int64.of_string "123456789123456" in Obj.repr (i,i));
+ Obj.repr (Failure "fail");
+ Obj.repr Bigarray.(Array1.init int16_unsigned c_layout 5 (fun x -> 8*x))
+|]
+
+(* Generate file with marshaled data *)
+
+let generate filename =
+ Out_channel.with_open_bin filename
+ (fun oc -> Marshal.(to_channel oc (data()) [Closures]))
+
+(* Try to unmarshal possibly malicious data. Clean failure is success. *)
+
+let test ic =
+ In_channel.set_binary_mode ic true;
+ begin try
+ ignore (Marshal.from_channel ic)
+ with Failure _ | Invalid_argument _ | Out_of_memory -> ()
+ end;
+ Gc.full_major()
+
+(* Internal fuzzing. Rather naive. *)
+
+let random_offset b =
+ (* Leave the header unchanged *)
+ 20 + Random.int (Bytes.length b - 20)
+
+let flip_one_byte b =
+ let p = random_offset b in
+ Bytes.set_uint8 b p (Random.int 0x100)
+
+let flip_one_bit b =
+ let p = random_offset b in
+ let m = 1 lsl (Random.int 8) in
+ Bytes.set_uint8 b p (Bytes.get_uint8 b p lxor m)
+
+let fuzz niter =
+ let d = Marshal.(to_string (data()) [Closures]) in
+ for i = 1 to niter do
+ let b = Bytes.of_string d in
+ begin match i land 4 with
+ | 0 -> flip_one_byte b
+ | 1 -> flip_one_bit b
+ | 2 -> flip_one_byte b; flip_one_byte b
+ | _ (*3*) -> flip_one_bit b; flip_one_bit b
+ end;
+ begin try
+ ignore (Marshal.from_bytes b 0)
+ with Failure _ | Invalid_argument _ | Out_of_memory -> ()
+ end;
+ Gc.full_major()
+ done
+
+let fuzz1 () =
+ let d = Marshal.(to_string (data()) [Closures]) in
+ let b = Bytes.of_string d in
+ for i = 0 to String.length d - 1 do
+ for x = 0 to 255 do
+ Bytes.set_uint8 b i x;
+ begin try
+ ignore (Marshal.from_bytes b 0)
+ with Failure _ | Invalid_argument _ | Out_of_memory -> ()
+ end;
+ Gc.full_major()
+ done;
+ Bytes.set_uint8 b i (Bytes.get_uint8 b i)
+ done
+
+let () =
+ Arg.parse [
+ "-o", Arg.String generate,
+ "<file> Save marshaled data to <file>";
+ "-n", Arg.Int fuzz,
+ "<num iter> Perform internal fuzzing test (random)";
+ "-x", Arg.Unit fuzz1,
+ "<num iter> Perform internal fuzzing test (exhaustive 1-byte)";
+ "-r", Arg.Unit (fun () -> test stdin),
+ " Read marshaled data from standard input"
+ ]
+ (fun s -> raise (Arg.Bad ("don't know what to do with " ^ s)))
+ "Usage: fuzzy [option].\nOptions are:"
Breakpoint 2 at 0x00000000000000
Breakpoint 3 at 0x00000000000000: file meander_c.c, line XXX.
Breakpoint 4 at 0x00000000000000: file meander.ml, line XXX.
-[Thread debugging using libthread_db enabled]
-Using host libthread_db library "/XXXX/libthread_db.so.1".
Breakpoint 1, <signal handler called>
frame 0: caml_start_program
frame 1: caml_startup_common
Breakpoint 2 at 0x00000000000000
Breakpoint 3 at 0x00000000000000: file meander_c.c, line XXX.
Breakpoint 4 at 0x00000000000000: file meander.ml, line XXX.
-[Thread debugging using libthread_db enabled]
-Using host libthread_db library "/XXXX/libthread_db.so.1".
Breakpoint 1, <signal handler called>
frame 0: caml_start_program
frame 1: caml_startup_common
Breakpoint 2 at 0x00000000000000
Breakpoint 3 at 0x00000000000000: file meander_c.c, line XXX.
Breakpoint 4 at 0x00000000000000: file meander.ml, line XXX.
-[Thread debugging using libthread_db enabled]
-Using host libthread_db library "/XXXX/libthread_db.so.1".
Breakpoint 1, <signal handler called>
frame 0: caml_start_program
frame 1: caml_startup_common
frame 5: meander`caml_main
frame 6: meander`main
frame 7: libc.so.6`__libc_start_call_main
-frame 8: libc.so.6`__libc_start_main_impl
+frame 8: libc.so.6`__libc_start_mainXXXX
frame 9: meander`_start
(lldb) continue
Process XXXX resuming
frame 6: meander`caml_main
frame 7: meander`main
frame 8: libc.so.6`__libc_start_call_main
-frame 9: libc.so.6`__libc_start_main_impl
+frame 9: libc.so.6`__libc_start_mainXXXX
frame 10: meander`_start
(lldb) continue
Process XXXX resuming
frame 10: meander`caml_main
frame 11: meander`main
frame 12: libc.so.6`__libc_start_call_main
-frame 13: libc.so.6`__libc_start_main_impl
+frame 13: libc.so.6`__libc_start_mainXXXX
frame 14: meander`_start
(lldb) continue
Process XXXX resuming
frame 14: meander`caml_main
frame 15: meander`main
frame 16: libc.so.6`__libc_start_call_main
-frame 17: libc.so.6`__libc_start_main_impl
+frame 17: libc.so.6`__libc_start_mainXXXX
frame 18: meander`_start
(lldb) quit
frame 5: meander`caml_main
frame 6: meander`main
frame 7: libc.so.6`__libc_start_call_main
-frame 8: libc.so.6`__libc_start_main_impl
+frame 8: libc.so.6`__libc_start_mainXXXX
frame 9: meander`_start
(lldb) continue
Process XXXX resuming
frame 6: meander`caml_main
frame 7: meander`main
frame 8: libc.so.6`__libc_start_call_main
-frame 9: libc.so.6`__libc_start_main_impl
+frame 9: libc.so.6`__libc_start_mainXXXX
frame 10: meander`_start
(lldb) continue
Process XXXX resuming
frame 10: meander`caml_main
frame 11: meander`main
frame 12: libc.so.6`__libc_start_call_main
-frame 13: libc.so.6`__libc_start_main_impl
+frame 13: libc.so.6`__libc_start_mainXXXX
frame 14: meander`_start
(lldb) continue
This version of LLDB has no plugin for the language "assembler". Inspection of frame variables will be limited.
frame 14: meander`caml_main
frame 15: meander`main
frame 16: libc.so.6`__libc_start_call_main
-frame 17: libc.so.6`__libc_start_main_impl
+frame 17: libc.so.6`__libc_start_mainXXXX
frame 18: meander`_start
(lldb) quit
(lldb) create ocaml_to_c
Breakpoint created for regex ocaml_to_c.
(lldb) run
+Process XXXX launched: 'XXXX' ($ARCH)
Process XXXX stopped
* thread #1, queue = 'XXXX', stop reason = breakpoint 1.1
frame #0: 0x00000000000000 meander`caml_start_program
Target 0: (meander) stopped.
-Process XXXX launched: 'XXXX' ($ARCH)
(lldb) backtrace
frame 0: meander`caml_start_program
frame 1: meander`caml_startup_common
Process XXXX resuming
Process XXXX stopped
* thread #1, queue = 'XXXX', stop reason = breakpoint 4.1
- frame #0: 0x00000000000000 meander`ocaml_to_c(unit=1) at meander_c.c:XX [opt]
+ frame #0: 0x00000000000000 meander`ocaml_to_c(unit=1) at meander_c.c:XX
2 #include <caml/callback.h>
3
4 value ocaml_to_c (value unit) {
gsub(/.c:[0-9]+:[0-9]+/, ".c:XX")
gsub(/.c:[0-9]+/, ".c:XX")
- # Replace libpath. Different distributions have different naming
- # schemes.
- gsub(/Using host libthread_db library "\/(.*)\/libthread_db\.so\.1"\./,
- "Using host libthread_db library \"/XXXX/libthread_db.so.1\".")
+ # GDB doesn't print these lines with musl.
+ gsub(/\[Thread debugging using libthread_db enabled\]/, "")
+ gsub(/Using host libthread_db library.*/, "")
# Replace line number when setting breakpoints in GDB.
gsub(/line [0-9]+/, "line XXX")
# Work around inconsistent name mangling
gsub(/c_to_ocaml_[0-9]+/, "c_to_ocaml")
+ # Work around symbol versioning
+ gsub(/__libc_start_main_impl$/, "__libc_start_mainXXXX")
+ gsub(/__libc_start_main@@GLIBC_[0-9]+.[0-9]+$/, "__libc_start_mainXXXX")
+
gsub("warning: This version of LLDB", "This version of LLDB")
gsub("This version of LLDB has no plugin for the language \"assembler\". Inspection of frame variables will be limited.", "")
# Replace printed match results
==================
WARNING: ThreadSanitizer: data race (pid=<implemspecific>)
- Write of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Write of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlArray_elt$writer_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
caml_failwith("test");
return Val_unit; /* Unreachable */
}
+
+value print_and_raise_many_args(value arg1, value arg2, value arg3, value arg4,
+ value arg5, value arg6, value arg7, value arg8,
+ value arg9)
+{
+ (void)arg1;
+ (void)arg2;
+ (void)arg3;
+ (void)arg4;
+ (void)arg5;
+ (void)arg6;
+ (void)arg7;
+ (void)arg8;
+ (void)arg9;
+
+ fprintf(stderr, "Hello from print_and_raise_many_args\n");
+ caml_raise_not_found();
+ return Val_unit; /* Unreachable */
+}
Leaving f
==================
WARNING: ThreadSanitizer: data race (pid=<implemspecific>)
- Write of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Write of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlExn_from_c$writer_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
--- /dev/null
+(* TEST
+
+ ocamlopt_flags = "-g -ccopt -O1 -ccopt -fno-omit-frame-pointer -ccopt -g";
+
+ set TSAN_OPTIONS="detect_deadlocks=0";
+
+ tsan;
+ readonly_files = "callbacks.c waitgroup_stubs.c";
+ all_modules = "${readonly_files} waitgroup.ml exn_from_c_stack_args.ml";
+ native;
+
+*)
+
+external print_and_raise_many_args
+ : int -> int -> int -> int -> int -> int -> int -> int -> int -> unit
+ = "print_and_raise_many_args" (* for bytecode, unused *)
+ "print_and_raise_many_args"
+
+open Printf
+
+(* We use two waitgroups (synchronizing barriers, not detectable by TSan). The
+ first barrier ensures that there is always a data race from TSan's point of
+ view, by delaying the synchronizing [Domain.join] until after both domains
+ have accessed the shared mutable field; and that these accesses always
+ happen in the same order (write first or read first).
+
+ The role of the second barrier is to always enforce the same order between
+ the TSan report and logging lines such as "Leaving f". Not enforcing that
+ order used to be a source of flakiness in the tests. *)
+let wg = Waitgroup.create 2
+let wg' = Waitgroup.create 2
+let r = ref 0
+
+let [@inline never] race () =
+ ignore @@ !r;
+ Waitgroup.join wg
+
+let [@inline never] i () =
+ printf "Entering i\n%!";
+ printf "Calling print_and_raise_many_args...\n%!";
+ print_and_raise_many_args 1 2 3 4 5 6 7 8 9;
+ printf "Leaving i\n%!"
+
+let [@inline never] h () =
+ printf "Entering h\n%!";
+ i ();
+ printf "Leaving h\n%!"
+
+let [@inline never] g () =
+ printf "Entering g\n%!";
+ h ();
+ printf "Leaving g\n%!"
+
+let [@inline never] f () =
+ printf "Entering f\n%!";
+ (try g ()
+ with Not_found ->
+ printf "Caught Not_found\n%!";
+ Printexc.print_backtrace stderr;
+ flush stderr;
+ race ());
+ Waitgroup.join wg';
+ printf "Leaving f\n%!"
+
+let [@inline never] writer () =
+ Waitgroup.join wg;
+ r := 1;
+ Waitgroup.join wg'
+
+let () =
+ Printexc.record_backtrace true;
+ let d = Domain.spawn writer in
+ f ();
+ Domain.join d
--- /dev/null
+Entering f
+Entering g
+Entering h
+Entering i
+Calling print_and_raise_many_args...
+Hello from print_and_raise_many_args
+Caught Not_found
+Raised by primitive operation at Exn_from_c_stack_args.i in file "exn_from_c_stack_args.ml", line 41, characters 2-45
+Called from Exn_from_c_stack_args.h in file "exn_from_c_stack_args.ml", line 46, characters 2-6
+Called from Exn_from_c_stack_args.g in file "exn_from_c_stack_args.ml", line 51, characters 2-6
+Called from Exn_from_c_stack_args.f in file "exn_from_c_stack_args.ml", line 56, characters 7-11
+==================
+WARNING: ThreadSanitizer: data race (pid=<implemspecific>)
+ Write of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
+ #0 camlExn_from_c_stack_args$writer_<implemspecific> <implemspecific> (<implemspecific>)
+ #1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
+
+ Previous read of size 8 at <implemspecific> by main thread (mutexes: write M<implemspecific>):
+ #0 camlExn_from_c_stack_args$race_<implemspecific> <implemspecific> (<implemspecific>)
+ #1 camlExn_from_c_stack_args$f_<implemspecific> <implemspecific> (<implemspecific>)
+ #2 camlExn_from_c_stack_args$entry <implemspecific> (<implemspecific>)
+ #3 caml_program <implemspecific> (<implemspecific>)
+
+ As if synchronized via sleep:
+ #0 nanosleep <implemspecific> (<implemspecific>)
+ #1 wg_wait <implemspecific> (<implemspecific>)
+ #2 camlExn_from_c_stack_args$writer_<implemspecific> <implemspecific> (<implemspecific>)
+ #3 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
+
+ Mutex M<implemspecific> (<implemspecific>) created at:
+ #0 pthread_mutex_init <implemspecific> (<implemspecific>)
+ #1 caml_plat_mutex_init <implemspecific> (<implemspecific>)
+ #2 caml_init_domains <implemspecific> (<implemspecific>)
+ #3 caml_init_gc <implemspecific> (<implemspecific>)
+
+ Mutex M<implemspecific> (<implemspecific>) created at:
+ #0 pthread_mutex_init <implemspecific> (<implemspecific>)
+ #1 caml_plat_mutex_init <implemspecific> (<implemspecific>)
+ #2 caml_init_domains <implemspecific> (<implemspecific>)
+ #3 caml_init_gc <implemspecific> (<implemspecific>)
+
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
+ #0 pthread_create <implemspecific> (<implemspecific>)
+ #1 caml_domain_spawn <implemspecific> (<implemspecific>)
+ #2 caml_c_call <implemspecific> (<implemspecific>)
+ #3 camlStdlib__Domain$spawn_<implemspecific> <implemspecific> (<implemspecific>)
+ #4 camlExn_from_c_stack_args$entry <implemspecific> (<implemspecific>)
+ #5 caml_program <implemspecific> (<implemspecific>)
+
+SUMMARY: ThreadSanitizer: data race (<systemspecific>:<implemspecific>) in camlExn_from_c_stack_args$writer_<implemspecific>
+==================
+Leaving f
+ThreadSanitizer: reported 1 warnings
--- /dev/null
+#!/bin/sh
+
+${program} 2>&1 \
+ | ${test_source_directory}/filter-locations.sh ${program} >${output}
Leaving f
==================
WARNING: ThreadSanitizer: data race (pid=<implemspecific>)
- Write of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Write of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlExn_in_callback$writer_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
Leaving f
==================
WARNING: ThreadSanitizer: data race (pid=<implemspecific>)
- Write of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Write of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlExn_reraise$writer_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
#3 camlPerform$entry <implemspecific> (<implemspecific>)
#4 caml_program <implemspecific> (<implemspecific>)
- Previous read of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Previous read of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlPerform$other_domain_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
#7 camlPerform$entry <implemspecific> (<implemspecific>)
#8 caml_program <implemspecific> (<implemspecific>)
- Previous read of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Previous read of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlPerform$other_domain_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
#4 camlPerform$entry <implemspecific> (<implemspecific>)
#5 caml_program <implemspecific> (<implemspecific>)
- Previous read of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Previous read of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlPerform$other_domain_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
In exception handler
==================
WARNING: ThreadSanitizer: data race (pid=<implemspecific>)
- Read of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Read of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlRaise_through_handler$reader_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
#1 camlRecord_field$entry <implemspecific> (<implemspecific>)
#2 caml_program <implemspecific> (<implemspecific>)
- Previous write of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Previous write of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlRecord_field$writer_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
#4 camlReperform$entry <implemspecific> (<implemspecific>)
#5 caml_program <implemspecific> (<implemspecific>)
- Previous read of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Previous read of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlReperform$other_domain_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
#10 camlReperform$entry <implemspecific> (<implemspecific>)
#11 caml_program <implemspecific> (<implemspecific>)
- Previous read of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Previous read of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlReperform$other_domain_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
#1 camlReperform$entry <implemspecific> (<implemspecific>)
#2 caml_program <implemspecific> (<implemspecific>)
- Previous read of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Previous read of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlReperform$other_domain_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
#2 camlUnhandled$entry <implemspecific> (<implemspecific>)
#3 caml_program <implemspecific> (<implemspecific>)
- Previous read of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Previous read of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlUnhandled$other_domain_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
#9 camlUnhandled$entry <implemspecific> (<implemspecific>)
#10 caml_program <implemspecific> (<implemspecific>)
- Previous read of size 8 at <implemspecific> by thread T1 (mutexes: write M<implemspecific>):
+ Previous read of size 8 at <implemspecific> by thread T2 (mutexes: write M<implemspecific>):
#0 camlUnhandled$other_domain_<implemspecific> <implemspecific> (<implemspecific>)
#1 camlStdlib__Domain$body_<implemspecific> <implemspecific> (<implemspecific>)
#2 caml_init_domains <implemspecific> (<implemspecific>)
#3 caml_init_gc <implemspecific> (<implemspecific>)
- Thread T1 (tid=<implemspecific>, running) created by main thread at:
+ Thread T2 (tid=<implemspecific>, running) created by main thread at:
#0 pthread_create <implemspecific> (<implemspecific>)
#1 caml_domain_spawn <implemspecific> (<implemspecific>)
#2 caml_c_call <implemspecific> (<implemspecific>)
cat<<EOF
------------------------------------------------------------------------
This should be fixable by just running tools/sync_stdlib_docs and
-eviewing the changes it makes.
+reviewing the changes it makes.
------------------------------------------------------------------------
EOF
git checkout .
set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% i686-w64-mingw32-gcc cygcheck\r
)\r
if "%PORT%" equ "mingw64" (\r
- set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% mingw64-x86_64-gcc-core\r
- set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% x86_64-w64-mingw32-gcc\r
+ rem mingw64-x86_64-runtime does not need explicitly installing, but it's\r
+ rem useful to have the version reported.\r
+ set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% mingw64-x86_64-gcc-core mingw64-x86_64-runtime\r
+ set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% x86_64-w64-mingw32-gcc cygcheck\r
)\r
if "%PORT%" equ "cygwin32" (\r
set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% cygwin32-gcc-core flexdll\r
set CYGWIN_UPGRADE_REQUIRED=%FORCE_CYGWIN_UPGRADE%\r
\r
for %%P in (%CYGWIN_PACKAGES%) do call :CheckPackage %%P\r
-set CYGWIN_INSTALL_PACKAGES=%CYGWIN_INSTALL_PACKAGES%,cygwin=3.6.1-1\r
call :UpgradeCygwin\r
\r
"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh install" || exit /b 1\r
# This must correspond with the entry in appveyor.yml
CACHE_DIRECTORY=/cygdrive/c/projects/cache
-if [[ -z $APPVEYOR_PULL_REQUEST_HEAD_COMMIT ]] ; then
- MAKE="make -j$NUMBER_OF_PROCESSORS"
-else
- MAKE=make
+MAKE=make
+
+# The environment is too large for xargs!
+unset ORIGINAL_PATH
+unset __VSCMD_PREINIT_PATH
+
+# There are some utilities on the AppVeyor runner which include mingw-w64
+# runtime DLLs which we don't want to be available in the build.
+export PATH="$(tr ':' '\n' <<<"$PATH" |
+ grep -vxFf <(which -a libwinpthread-1.dll |
+ xargs -r dirname) |
+ paste -sd:)"
+if which 'libwinpthread-1.dll' 2>/dev/null; then
+ echo 'Failed to remove libwinpthread-1.dll from PATH'
+ exit 1
fi
git config --global --add safe.directory '*'
$FULL_BUILD_PREFIX-$PORT/runtime/*.a \
$FULL_BUILD_PREFIX-$PORT/otherlibs/*/lib*.a
fi
+ # Check that libwinpthread-1.dll is not linked
+ cd "$FULL_BUILD_PREFIX-$PORT"
+ find . -name \*.exe | xargs ldd > results
+ winpthreads='^[[:blank:]]libwinpthread-[^.]\+\.dll =>'
+ if grep -q "$winpthreads" results; then
+ echo 'winpthreads is not being linked statically:'
+ grep ':$\|'"$winpthreads" results | grep -B 1 "$winpthreads"
+ exit 1
+ fi
+ rm -f results
run_testsuite=true
if [[ -n $APPVEYOR_PULL_REQUEST_NUMBER ]]; then
API_URL="https://api.github.com/repos/$APPVEYOR_REPO_NAME/issues/$APPVEYOR_PULL_REQUEST_NUMBER"
- if curl --silent "$API_URL/labels" | grep -q "no-testsuite"; then
+ if curl --silent "$API_URL/labels" | grep -q 'CI: Skip testsuite'; then
run_testsuite=false
fi
fi
if $run_testsuite; then
# The testsuite is too slow to run on AppVeyor in full. Run the dynlink
# tests now (to include natdynlink)
+ # GNU Parallel 20250122 introduced a somewhat dubious check on the
+ # characters in $PWD and $OLDPWD - --unsafe disables these "checks"
+ # (as would sed -i -e 's/PWD OLDPWD//' /usr/bin/parallel)
+ export PARALLEL='--unsafe'
run "test dynlink $PORT" \
$MAKE -C "$FULL_BUILD_PREFIX-$PORT/testsuite" parallel-lib-dynlink
# Now reconfigure ocamltest to run in bytecode-only mode
set -o pipefail
# For an explanation of the sed command, see
# https://github.com/appveyor/ci/issues/1824
+ build="-C ../$BUILD_PREFIX-$PORT"
script --quiet --return --command \
- "$MAKE -C ../$BUILD_PREFIX-$PORT" \
+ "if ! $MAKE -j $build; then $MAKE $build; exit 1; fi" \
"../$BUILD_PREFIX-$PORT/build.log" |
- sed -e 's/\d027\[K//g' \
+ sed --unbuffered \
+ -e 's/\d027\[K//g' \
-e 's/\d027\[m/\d027[0m/g' \
-e 's/\d027\[01\([m;]\)/\d027[1\1/g'
rm -f build.log;;
esac
find "../$BUILD_PREFIX-$PORT" -type f \( -name \*.dll -o -name \*.so \) | \
xargs rebase -i "$ARG"
+ find "../$BUILD_PREFIX-$PORT" -type f \( -name \*.dll -o -name \*.so \) | \
+ xargs ldd
;;
esac
confoptions="$confoptions --enable-flambda --enable-flambda-invariants"
fi
-eval ./configure "$CCOMP" $build $host --prefix='$instdir' $confoptions
+main_build() {
+ eval ./configure "$CCOMP" $build $host --prefix='$instdir' $confoptions
-grep -q '^NATIVE_COMPILER=false' Makefile.config && make_native=false
+ grep -q '^NATIVE_COMPILER=false' Makefile.config && make_native=false
-if test "$flambda" = "true" && test "$make_native" = "false"; then
- echo "No need to test flambda in a bytecode-only system; skipping the test."
- exit 0
-fi
+ if test "$flambda" = "true" && test "$make_native" = "false"; then
+ echo "No need to test flambda in a bytecode-only system; skipping the test."
+ exit 0
+ fi
-if $bootstrap; then
- $make $jobs --warn-undefined-variables core
- $make $jobs --warn-undefined-variables bootstrap
- if $make_native; then
- $make $jobs --warn-undefined-variables opt.opt
+ if $bootstrap; then
+ $make $jobs --warn-undefined-variables core
+ $make $jobs --warn-undefined-variables bootstrap
+ if $make_native; then
+ $make $jobs --warn-undefined-variables opt.opt
+ fi
+ else
+ $make $jobs --warn-undefined-variables
fi
-else
- $make $jobs --warn-undefined-variables
-fi
+ if $make_native && $check_make_alldepend; then
+ $make --warn-undefined-variables alldepend
+ fi
-if $make_native && $check_make_alldepend; then
- $make --warn-undefined-variables alldepend
-fi
+ $make --warn-undefined-variables install
+ rm -rf "$instdir"
+}
+
+# PATH, but without any homebrew additions (tests vanilla macOS in the build,
+# while still allowing full utilities later in the testsuite)
+CLEAN_PATH=$(echo "$PATH" | tr ':' '\n' | grep -vF '/homebrew/' | paste -sd: -)
-$make --warn-undefined-variables install
-rm -rf "$instdir"
+PATH="$CLEAN_PATH" main_build
cd testsuite
if test -n "$jobs" && test -x /usr/bin/parallel
export OCAMLTEST_SKIP_TESTS="tests/afl-instrumentation/afltest.ml \
tests/afl-instrumentation/afl-fuzz-test.ml \
-tests/runtime-errors/stackoverflow.ml"
+tests/runtime-errors/stackoverflow.ml \
+tests/native-debugger/linux-gdb-amd64.ml \
+tests/native-debugger/linux-lldb-amd64.ml \
+tests/native-debugger/linux-gdb-arm64.ml \
+tests/native-debugger/linux-lldb-arm64.ml \
+tests/native-debugger/linux-gdb-riscv.ml"
jobs=-j8
make=make
# Don't optimize too much to get better backtraces of errors
CFLAGS="-Og -g -fno-omit-frame-pointer $sanitizers"
LDFLAGS="$sanitizers -Og -g"
-CC=$clang
+CC="$clang -Og -g"
# Test that UBSAN works
cat >ubsan.c <<EOF
projects / ocaml.git / commitdiff